# sip client kludge 
implement Command; 

Mod : con "sipc"; 
Version : con "SIP/2.0" ; 
Transport : = "UDP"; 

include "sys.m"; 
sys: Sys; 

stderr : ref Sys->FD; 
include "draw.m"; 
include "daytime. m"; 
include "csget.m"; 
day t ime : Day t ime ; 
include "sh.m"; 

# Optional audio driver for ephone 

# Typically this is in " /prod/shanip/module/UCBAudio.m" 

# use namespace to place it: bind -a /prod/shanip/module /module 
include "UCBAudio.m" ; 

ua : UCBAudiO; 

# Default init values 
default_lport : con "5060"; 
default_rtpport : con "3456"; 
default_rrtport : con "3466"; 
default_client : con "8089:8089"; 
default_aproto : con "RTP/AVP"; 
default_exptime : con "3600"; 

# RTP and remote RTP ports (default RTCP is 1+) 
Rtpport := def ault_rtpport; 

Rrtport := default_rrtport; 

# Registration expiration 
Exptime := def ault_exptime; 

# Proxy/ Registrar definition example: 

ft Proxy : string » "135.1.89.127:5060"; 
Proxy, Registrar : string; 

# Audio protocol selection 
Aproto :=* default_aproto; 

# This client local address (or substituted address) 
Laddr : string; 

active := 0; 
Epid := 0; 

# To reset the client process 
Args : list of string; 

# To delay first registration 
Zreg : = 0; 

ft Debug level 
Dbg := 0; 

ft Verbose level message sent /received contents only 
Vbs := 0; 

init(ctxt : ref Draw->Context, args : list of string) 
< 

Args = args; 

sys = load Sys Sys -> PATH; 

stderr = sys->f ildes (2 ) ; 

daytime = load Daytime Dayt ime -> PATH; 

if (daytime == nil) ( 

sys->fprint (stderr, Mod+": load %s: %r\n", Dayt ime ->PATH) ; 

return; 

} 

ua * load UCBAudio UCBAudio->PATH; 
if (ua != nil) { 

(ok, reason) : = ua->initialize ( ) ; 

if (ok < 0) sys->f print (stderr, Mod+": %s\n", reason); 

) 

cs := load CsGet CsGet->PATH; 
(nil, Laddr, nil) = cs->hostinf o (nil ) 
if (Laddr == nil) return; 

if (Dbg) sys->print (Mod+" : local address: %s\n", Laddr) ; 

if (args != nil) 
args = tl args; 

ok : int; 
client : string; 

(ok, client, args) = parseopt (args) ; 
if (!ok) return; 

if (client « nil) client = default_client; 

if (numberp (client ) ) client += "@* : "+client; 
client ■ thisclient (client) ; 

sys->print (Mod+" : thisclient: %s\n", client); 
C = ref Calls(nil, nil, nil); 

if (args != nil) 

clients = args; 
else if (Registrar == nil) { 

sys->print (Mod+" : using Styx locator for SIP clients\n"),- 

readclients( ) ,- 

registerclient (client) ; 

} 

if ( isiplisten (client) ) return; 

if (Registrar l= nil && !Zreg) 

C.this = register (client, nil); 

ch := chan of int; 
spawn sound (ch) ; 
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Spid = <- ch; 

if (Dbg) sys->print (Mod+" : sound process %d\n", Spid)? 
spawn rcmd(ctxt, client_nonet (client ) , ch) ; 
pid := <- ch; 

if (Dbg) sys->print (Mod+" : command process %d\n", pid); 
if (ua != nil) { 

spawn listenkeys (ch) ,- 

Epid » <- ch; 

if (Dbg) sys->print(Mod+": ephone process %d\n", Epid); 

) 



usage ( ) 

sys->print ( "usage: sip\t [options) [this_client] [other_client] . . . [more client entries] \n\toptions: \n\t\t-a\t-- specify audio protocol : ud} 

) 

parseopt Orgs : list of string) : (int, string, list of string) 
( 

client : string; 
atcp := 0; 

Out: 

for (; args != nil; args * tl args) { 
opt := hd args; 
case opt { 

•?" or •-?" or "help" or "-help" => usageO; return (0, nil, args); 
"-a" => ( 

args = tl args; 

if (args != nil) { 

case hd args { 

"tcp" or "TCP" or "RTP/TCP" or "RTP/TCP/AVP" => AprotO = "RTP/TCP"; atcp = 1; 
* => Aproto = default_aproto; 

) 

} 

if (Dbg) sys->print (Mod+ " : audio protocol set to %s\n", Aproto); 

) 

"-b" => { 

args = tl args; 
if (args !** nil) ( 

(rt, rr) := expand2t (hd args, "/"); 
if (rt != nil) { 

Rtpport = rt; 

if (rr != nil) Rrtport = rr; 

else Rrtport = string (int rt + 10); 

) 

else { 

Rtpport = default_rtpport; 
Rrtport = default_rrtport; 

) 

} 

if (Dbg) sys->print (Mod+" : audio RTP ports set to %s/%s\n", Rtpport, Rrtport); 

) 

■-d" => Dbg++; 
■-V" => Vbs++; 
■-1- => { 

args = tl args; 

if (args != nil) { 

val := hd args; 

sys->print (Mod+" : local address set %s -> %s\n", Laddr, val); 



Laddr = val; 

} 



> 

"-P" => { 

args = tl args; 
if (args != nil) { 

val := hd args; 
if (val == "-") { 

proxies := readlist (" /services/ server /sip_proxies" ) ; 
if (proxies != nil) Proxy = Registrar = hd proxies; 

else sys->fprint (stderr, Mod+": empty /services/server/sip_proxies" ) ; 

) 

else { 

Proxy = val; 

if (Registrar == nil) Registrar = val; 

} 

if (Dbg) sys->print (Mod+" : proxy set to %s\n", Proxy); 

} 

} 

"-r" => { 

args = tl args; 
if (args •= nil) { 

Registrar = hd args; 

if (Dbg) sys->print(Mod+" : registrar set to %s\n" , Registrar); 

) 

) 

"-z" => { 

Zreg ++; 

if (Dbg) sys->print (Mod+" : registration postponed\n" ) ; 

> 

"-o" or "-ol" => { 

args = tl args; 
if (args != nil) { 

Port_offset = int hd args; 

if (Dbg) sys->print(Mod+" : port offset set to %d\n", Port_of f set) ; 

) 



) 



or "-o2" => { 
args = tl args; 
if (args != nil) { 

Aport__of fset ■ int hd args; 

if (Dbg) sys->print (Mod+" : announced port offset set to %d\n", Aport_of f set ) ; 

) 

{ 

if (opt != nil) ( 

if (opt[0] == '$') { 

nc := int opt [1:1; 

client = nth(nc, readlist (" /services/ conf ig/sip_phones" )) ; 

} 

else if (client == nil) client = opt; 

if (Dbg) sys->print(Mod+" : client set to %s\n", client); 
args = tl args; 

) 

break out; 



) 

) 

) 

if (atcp) tcpaudioO; 
return (1, client, args); 
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sip_Aport := default_lport; 
siplisten (client : string) : int 
{ 

ch := chan of int; 

ok : int; conn : Sys- Connection; 

if (client != nil) ( 

(nil. nil, port, nil) := expandnet (client) ; 

net := downcase (Transport ) ; 

sip_Aport = port; 

(ok, conn) = announce (net, "*", port); 
if (ok < 0) return 0; 
spawn listen (client, conn, ch) ; 
active = <- ch; 

if (Dbg) sys->print(Mod+": listen process %d\n', active) ,- 
if ([Monpid) { 

spawn monitor (client, ch) ; 

Monpid ~ <- ch; 

if (Dbg) sys->print (Mod+" : monitor process %d\n", Monpid) ; 

) 

> 

return 1; 

} 

Monpid := 0; 

monitor (client : string, ch : chan of int) 
{ 

Ch <- = sys->pctl{0, nil); 
while (Monpid) { 

sys->sleep (Timeout ) ; 

if (iMonpid) return; 

for (1 C.clist; 1 != nil; 1 = tl 1) ( 
c := hd 1; 

if (c == nil | | !c. expire) continue; 
if (c. expire <= timeO) { 

c. expire *■ 0; 

c.resend(client) ; 

) 

) 

} 

} 

Lastrt :=» 0; 

restartsip (client : string, c : ref Call) : int 
{ 

if ((nt := timet) ) > Lastrt) { 
Lastrt * nt + Timeout; 

sys->fprint(stderr, Mod+': would restart sip listener \n" ) ; 
nt = 0; 
return 1; 

) 

pid := 0; 
if (-nt) { 

pid = active; 

active = 0; 

) 

if (c.conn != nil) c.conn.dfd = nil; 
c.conn = nil; 
if (!nt) { 

sys->sleep(100) ; 

kill (pid) ; 

) 

if (C-this != nil) C. this. conn = nil; 
if (C.recv != nil) C.recv.conn = nil; 
if (int) ( 

sys->sleep(100) ; 

if (siplisten(client) ) return 1; 

else sys->fprint (stderr, Mod+": cannot restart sip listener\n" ) ; 

) 

return 0; 



include "kill.m"; 
kp : Kill; 

kill (pid : int) 

if (kp ™ nil) kp = load Kill Kill->PATH; 
kp->killpid(string pid, array of byte "kill"); 



cleanup( ) 

killsoundO; 
pid := Monpid; 
Monpid = 0; 
sys->sleep(100) ; 
kill (pid); 

for (1 := C.clist; 1 i= nil; 1 = tl 1) { 
C := hd 1; 

if (c != nil && c session != nil) 
c . session . endaudio ( > ; 

) 

if (pid = active) ( 
active = 0; 
sys->sleep(100) ; 
kill (pid) ; 

) 

if (pid = Epid) ( 
Epid = 0; 
sys->sleep (100) ; 
kill (pid) ; 

} 

cleanClist (1) ; 
Dbg = 0; 

) 

# /tmp/sipcmd channel to control client from another program 

# this does not deal with digit collection yet... 

tsipsrv : con "sipcmd"; 
sipsrv : con "sc"; 
mp : con "/tmp"; 

rcmd(ctxt : ref Draw->Context, client : string, rch : chan of int) 
{ 

sys->bind( "ts" , mp, sys->MBEFORE) ; 
ch := sys->f ile2chan(mp, sipsrv); 
if (ch « nil) { 
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rch <- = 0 ; 

sys->fprint(stderr, Mod+": file2chan %s/%s %r\n", mp, sipsrv); 
return; 

> 

else rch <- = sys->pctl(0, nil); 

if (Dbg) sys->print(Mod+": %s/%s is the command interpreter^" , mp, sipsrv); 

run :■ 1; 
reset := 0; 
while (run) { 
alt { 

(o, data, fid, wc) := <- ch. write => 

if (data nil && wc != nil) { 
sdata := string data; 

if (Dbg) sys->print (Mod+"> %s", sdata); 
if (sdata == "restart") { 
run = 0; 

restartdevice (ctxt ) ; 

} 

else if (sdata == "reset") reset « i (run = 0); 
else run =» sipdo (client, sdata) ; 
wc <- = (len data, nil); 

) 

(o, n, fid, rc) := <- ch.read => 

data := array of byte "sip commands - write help to read the menu"; 
if (rc i = nil n > 0) ( 

if (n < len data) data = data[0:n]; 
rc <- a (data, ■"> ; 

> 

else if (rc ! = nil) rc <- ■ (nil, ""); 

} 

} 

sys->unmount ("is" , mp) ; 
cleanupO; 

if (reset) spawn init(ctxt, Args); 



Call : adt 
{ 

conn : ref Sys->Connection; 

path : ref Path; 

fruro : string; 

tu : string; 
callid : string; 

cseq : string; 

state : string; 

session : ref Session; 

expire : int; 

msg : string; 

inited : int; # True when call initiated on this end 

store : fn(c : self ref Call, c2 : ref Call); 

send : fn(c : self ref Call, client : string) : ref Call; 

resend : fn(c : self ref Call, client : string); 

resendmsg : fn(c : self ref Call, client, msg : string); 

nextstate : fn(c : self ref Call, client : string); 

disconnect : fn(c : self ref Call, client, end : string) : ref Call; 

addsession : fn(c : self ref Call, sid, data : string) : int; 

addedsessionp : fn(c : self ref Call) : int; 

stateinfo : fn(c : self ref Call) : (string, int, string); 

activep ; fn(c : self ref Call) : int; 

endp : fn(c : self ref Call) : int; 

registerp : fn(c : self ref Call) : int; 

); 

Call.stateinfo(c : self ref Call) : (string, int, string) 
( 

if (c « nil) return (nil, 0, nil); 

s := estate; 

token, num, msg : string; 

(nil. Is) := sys->tokenize(s, " \f); 

if (Is != nil) 

if (tl Is != nil) { 

token = hd Is; 
num = hd tl Is; 

fortl := tl tl Is; 1 != nil; 1 = tl 1) ( 
msg += hd 1; 

if (tl 1 != nil) msg += " "; 

) 

} 

else token = hd Is; 
else token = estate; 
n := 0; 

if (num ! = nil) 

if (numberp(num) ) n = int num; 

else sys->fprint (stderr, Mod+" : unexpected state %s %s\n" , token, num); 
if (Dbg > 2) sys->print(Mod+": stateinfo -> (%s. %d, %s)\n", token, n, msg); 
return (token, n, msg); 



Call.store(cl : self ref Call, c2 : ref Call) 
{ 

cl. state = c2. state; 

# preserve recorded route for future requests (e.g. ack) 
if (c2.path != nil) { 

if (cl.path »- nil j| c2 .path. record •= nil) { 

if (Dbg) sys->print (Mod*" : storing new path in call (record route) %s\n", cl. callid); 
ft assume contact not changed 

cl -path = c2 .path; 
) else if (c2. path. route != nil) { 

if (Dbg) sys->print (Mod+" : storing new path in call (route) %s\n", cl. callid); 
cl .path ** c2 .path; 
route := c2 .path. route ; 
cont c2 .path. contact; 
if (cont •= nil) { 

cont = mksipurl (sipurlval (cont) ) ; 

if (Dbg) sys~>print (Mod+" : rewriting route in call %s using %s\n" , cl. callid, cont); 
r := cont : : nil; 

for (; route !« nil; route ■ tl route) 

if (tl route != nil) r = hd route :: r; 
cl .path. route = r; 

) 

via := c2. path. via; 
if (via !» nil && cont != nil) { 
cl .path. contact = cont; 

if (Dbg) sys->print (Mod+" : rewriting via in call %s using %s\n", cl. callid, cont); 

v := mkvia(cont) :: nil; 

for (; via ! o nil; via => tl via) 

if (tl via 1= nil) v - hd via :: v; 
cl.path. via = v; 
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> 

cl.frum ■ c2.frum; 
cl .tu = c2 .tu; 
Cl.inited = c2.inited; 
cl .cseq = c2 .cseq; 



Session : adt 
{ 

sid : string; 

data : string; 

rdata : list of string; 

audio : ref Audio; 

endaudio : fn(s : self ref Session); 
startaudio : fn{s : self ref Session, tipe : int); 
dialaudio : fn(s : self ref Session); 
announceaudio : fn(s : self ref Session); 



Audio : adt 
{ 



addrl : string; 
addr2 : string; 
tipe : int; 

connl : ref Sys- Connection; 
conn2 : ref Sys- Connection; 
listen : int; 
speak : int; 
rtcpl : int; 
rtcp2 : int; 

cconl : ref Sys -Connection ; 
ccon2 : ref Sys- Connect ion; 
size : int; 
busy : int; 



Calls : adt 
{ 

clist : list of ref Call; 
this : ref Call; 
recv : ref Call; 

find : fn(cl : self ref Calls, id : string) : ref Call; 
item : fnlcl : self ref Calls, n : int) : ref Call; 
next : fn(cl : self ref Calls) : ref Call; 
take : fntcl : self ref Calls, c : ref Call); 
add : fn{cl : self ref Calls, c : ref Call); 
rera : fntcl : self ref Calls, c : ref Call) : int; 
remrecv : fn(cl : self ref Calls, c : ref Call) : int; 
print : fntcl : self ref Calls) ; 

}; 

i Master call list 
C : ref Calls; 

Calls. print (cl : self ref Calls) 
{ 

sys->print (Mod+" : call list:\n"); 

i := 0; 

Ct := C.this; 

cr := C.recv; 

for (1 := cl. clist; 1 != nil; 1 = tl 1) { 
c := hd 1; 
mode : string; 

if (ct == c) (mode = "this call"; ct = nil;} 

else if (C.recv == c) {mode = "recv call"; cr = nil;} 

else mode = ""; 

sys->print("%d: call %s %s %s\n" , ++i, c.callid, estate, mode); 

) 

if (ct nil) sys->print ( "?: idle %s %s this call\n", ct.callid, ct. state); 
if (cr != nil) sys->print ( "? : idle %s %s recv call\n", cr. callid, cr. state); 

> 

Calls. find(cl : self ref Calls, id : string) : ref Call 
{ 

for (1 := cl. clist; 1 != nil; 1 = tl 1) 
if ({hd D.callid == id) return hd 1; 
return nil; 

} 

Calls. item(cl : self ref Calls, n : int) : ref Call 
{ 

i := 1; 

for (1 := cl. clist; 1 != nil; 1 = tl 1) 

if (i — n) return hd 1; 

else i++; 
return nil; 

} 

Calls. next (cl : self ref Calls) : ref Call 
{ 

c := cl.this; 

for (1 :« cl. clist; 1 != nil; 1 = tl 1) 
if {hd 1 == c) 

if (tl 1 »= nil) return hd tl 1; 
else return hd cl. clist; 

return nil; 

} 

Calls. take (cl : self ref Calls, c : ref Call) 
{ 

if (c != nil) { 

if (cl. clist •= nil && cl.this != nil && cl . this .callid != c.callid) { 

if {Proxy != nil && c.conn nil && cl.this. conn != nil) c.conn = cl . this. conn; 

if {Dbg > 1) sys->print{Mod+" : switching call %s -> %s\n", cl .this .callid, c.callid) ; 

} 

pc := cl .findtc. callid); 
if (pc !» nil) { 

if {pc == c) { 

cl.this = c; 

cl .remrecv (c) ; 

return; 

} 

else cl.rem(pc) ; 

) 

cl. clist o (cl.this = c) : : cl. clist; 

) 

} 
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Calls. add(cl : self ref Calls, c : ref Call) 
{ 

if <c l= nil) { 

pc := cl .find(c.callid) ; 
if (pc != nil) cl.rem(pc); 
Cl.clist = c :: cl.clist; 

) 

) 

Calls. remrecv(cl : self ref Calls, c : ref Call) : int 
{ 

if (cl.recv != nil && cl .recv.callid == c.callid) { 
cl.recv = nil; 
return 1; 

) 

return 0; 

> 

Calls. rem (cl : self ref Calls, c : ref Call) : int 
{ 

if (c »» nil) return 0; 

if (Dbg > 1) sys->print (Mod+" : removing call %s\n", c.callid) ; 
n := 0; 

r : list of ref Call; 

for (1 := cl.clist; 1 != nil; 1 = tl 1) 

if (hd 1 != c && (hd D.callid ! = c.callid) r = hd 1 :: r; 

else n++; 
cl.clist = reversec(r); 
if (cl.this == c) 

if (cl.clist != nil) cl.this = hd cl.clist; 

else cl . this = nil; 
if (cl.recv == c) cl.recv = nil; 
cl .remrecv(c) ; 
return n; 

) 

reversecd : list of ref Call) : list of ref Call 
( 

r : list of ref Call; 

for<; 1 != nil; 1 = tl 1) r hd 1 :: r; 
return r; 

) 

sipdo(client, cmd : string) : int 
{ 

c := C.this; 

(nil, cl) := sys->tokenize(cmd, " \t\r\n"); 
if (cl « nil) return 1; 
Sch <- = ("•, 0) ; 
case hd cl ( 

-a' => { 

if (tl cl != nil) { 

line := hd tl cl; 
called : string; 
if (Proxy « nil) { 

if (Ldomain != nil && pos('@*. line) < 0) 

called = f indclient (line+Ldomain) ; 
if (called « nil) 

called = f indclient (line) ; 

> 

else if (Ldomain != nil && pos('@', line) < 0) called = line + Ldomain; 
else called = line; 

if (called == client) { 

sys->f print (stderr, Mod+": calling self %s\n", client); 
Sch <- = ("x", -1); 

) 

else if (called != nil) { 

if (Dbg) sys->print(Mod+" : calling %s\n", called); 

c = connect (client, called, c); 

C.take(c) ,- 

Sch <- » ("w", -1) ,- 

) 

else { 

sys->f print (stderr, Mod+": client not found at line %s\n", line); 
Sch <- = Cx 1 , -1); 

} 

} 

else if (c != nil && ! c . registerp ( ) ) { 

if (estate « "INVITE 180 Ringing") ( 

estate o "INVITE 200 OK"; 

c. send (client) ,- 
} else if (start ("INVITE ", estate)) 

c.nextstate(client) ; 

else 

if (Dbg) sys->print(Mod+" : in call %s %s\n", c.callid, estate); 

} 

else { 

sys->f print (stderr, Mod+": missing line number\n">; 
Sch <- = ("x", -1); 

> 

return 1 

) 

•£■ => { 

if (tl cl != nil) { 

cn := int hd tl cl; 

c = C. item(cn) ; 

if (c != nil) C.taxe(c); 

else sys->fprint (stderr, Mod+": call number %d not foundVn", cn) ; 

) 

else { 

c = C.next ( ) ; 

if (c != nil) C.take(c); 

} 

return 1; 

•1" => { 

C. print (); 
return 1; 

•r" => { 

c = register (client, c); 

if (C.this == nil) C.this = c; 

return 1; 

-z- «> { 

if (c == nil) c = C.this «* C.recv; 

if (c == nil) sys->f print (stderr, Mod+": no current call\n">; 
else { 

if (estate « " INVITE 200 OK" (j estate « "ACK" ) { 
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#c. state = "ACK"; 

c = c. disconnect (client, "BYE"); 

C.take(c) ; 

C.rem(c) ; 

return 1; 

} 

else { 

if ( ! start ( "BYE" , estate) && ! start ( "REGISTER" , estate)) { 
c = c. disconnect {client, "CANCEL" ) ; 
C.take(c) ; 

) 

C.rem(c) ; 
return 1; 

> 

> 

S.s = S.d = nil; 
if (c != nil) { 

c.inited = 0; 

C.rem(c) ; 

} 

cleanClist (0) ; 

) 

"q" => return 0; 
* => < 

cmd := hd cl; 

if (cmd != nil) { 

case cmd[0] { 

'-' or '=' => { 

eql := crodlOl == •-' ; 
cl = tl Cl; 

if ((cmd = cmd[l:]) != nil) cl = cmd :: cl; 
if (eql) cl - :: cl; 

test (cl) ; 
return 1; 

) 

) 

sys->fprint (stderr, Mod+": a <number>, f, 1, q, r, z, and (-, =) [cmd] : are supported commands\n" ) ; 

) 

} 

return 1; 

} 

include "qidcmp.m"; 
qc : Qidcmp; 
Cdir : import qc; 

clients : list of string; 

Spath : con "/services/server/sip_clients" ; 
Sqid : ref Cdir; 

# load the last record of all clients that connected via sip 
readclientsO : list of string 

{ 

if (Sqid == nil) ( 

qc = load Qidcmp Qidcmp->PATH; 
if (qc == nil) { 

sys->f print (stderr, Mod+": %s %r\n", Qidcmp->PATH) ; 

return nil; 

> 

qc->init (nil , nil); 

Sqid = ref Cdirtnil, Qidcmp->SAME) ; 

} 

if (Sqid. femp (Spath) ) { 

if (Dbg) sys->print (Mod+" : updating Styx SIP clients\n" ) ,- 
clients = readlist (Spath) ; 

} 

return clients; 

) 

addclients (client : string) 

if (Dbg) sys->print (Mod+" : adding SIP client locator %s\n" , client) ; 
fappend( Spath, client); 
readclientsO ; 

} 

replaceclients(new, old : string) 

if (Dbg) sys->print(Mod+": updating SIP client locator %s -> %s\n". old, new); 
r : list of string; 

for (1 := clients; 1 != nil; 1 « tl 1) 

if (hd 1 == old) r = new : : r; 

else r = hd 1 : : r; 
clients ■ reverse(r); 
writelist (Spath, clients); 
readclientsO ; 

) 

registerclient (client : string) 
{ 

(1, a, p) := expand (client ) ; 
host := f indclient (1) ; 
if (host == nil) 

addclients (client) ; 
else if (host != client) 

replaceclients(client, host) ; 

) 

f indclient (line : string) : string 
( 

readclients { ) ; 

ford := clients; 1 != nil; 1 = tl 1) { 
(num, nil, nil) := expand (hd 1); 
if (num == line) return hd 1; 

} 

return nil; 

) 

# Local domain starts with @ 
Ldomain : string; 

thisclient (client : string) : string 
{ 

(who, laddr, port) := expand (client) ; 
if ({p := posOG', who)) >= 0) ( 
Ldomain ■ wholp:]; 

if (Dbg) sys->print (Mod+" : local domain %s\n", Ldomain); 

) 
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if (Laddr != laddr && addressp(laddr) == 1) < 

sys->print (Mod+" : local address substitute: %s -> %s\n", Laddr. laddr); 
Laddr = laddr; 

} 

return who+"@"+laddr+" : •+thisport (port) ; 

} 

thisporttp : string) : string 
{ 

(n, lp) := sys->tokenize(p, "/"); 
case n { 

1 => Transport = "UDP*; 

2 => {Transport = upcase (hd lp) ; p = hd tl lp; } 

* => sys->f print (stderr, Mod+": unexpected port argument %s\n", p) ; 

} % 

return downcase (Transport )+"/"+p; 

> 

ntimeO : int 
{ 

return int le+09 + daytime->now( ) j 

} 

rtimeO : int 
( 

return daytime- >now{ ) ; 

) 

Timeout := 16000; 
etimeO : int 
I 

return sys->millisec ( ) + Timeout; 

} 

time() : int 
{ 

return sys->raillisec { ) ,- 

) 

explicitport (entry, port : string) : string 
( 

if (port != default_lport) entry += ":"+port; 
else if (Proxy != nil) ( 

(nil, nil, pp, nil) := expandnet (Proxy) ; 

if (port != pp) entry += ":"+port; 

) 

if (Dbg) sys->print(Mod+" : explicitport ( ) -> %s\n", entry); 
return entry; 

> 

proxy(client : string) : string 
{ 

if (Proxy == nil) return client; 
return Proxy; 

} 

proxytypeO : string 
( 

if (Proxy != nil) { 

(t, nil, nil) := expand ( Proxy) ,- 
return t; 

} 

return nil; 

} 

mkvia (client : string) : string 
{ 

if (client != nil) { 

(nil, vaddr, vport, net) := expandnet (client) ; 

# remove the line© since it crashes vovida phones 
ftreturn " "+Version+"/ "+upcase (net)+" "+client; 
entry := " " +Version+" / " +upcase (net) + " "+vaddr; 
return explicitport (entry, vport) ; 

> 

return nil; 

} 

viaproxy (proxy, contact : string, via : list of string) : list of string 
{ 

if (proxy != nil) return mkvia (proxy) :: via; 

else if (contact != nil) return mkvia (contact ) :: via; 

else return via; 

} 

numberp(s : string) : int 
( 

for (i := 0; i < len s; i++) { 
c := s [i] ; 

if (c < '0' || c > '9') return 0; 

} 

return 1; 

} 

# may be an ip address field 
addrfp(s : string) : int 
( 

for (i := 0; i < len s; i++) { 

if ( (c >='0' c <= '9') || (c >= 'a' c <= 'z') |j (c >= 'A' && c <= 'Z') | | c == '-') continue; 
else return 0; 

} 

return 1; 

} 

» return 1 if numeric address > 1 if hostname 0 if neither 

addressp(s : string) : int 

( 

(n, 1) := sys->tokenize(s, "."); 

r := 1; 

if (n <= 1) { 

if (1 != nil && addrfp(hd 1)) ++r; 

else return 0; 

} 

else for (; 1 1= nil; 1 = tl 1) 
if ( !numberp(hd 1) ) 

if (addrfpthd 1)) ++r,- 
else return 0; 

return r; 

) 
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expand (client : string) : (string, string, string) 
{ 

(n. la) := sys->tokenize {client, '&"); 
pa := client; 

line, addr, port : string; 
if (n >= 2) { 

if (n > 2) 

for(l :» la; 1 != nil; 1 = tl 1) { 
line +- hd 1; 
if (tl 1 != nil) 

if (tl tl 1 != nil) line +» "6"; 
else { pa = hd tl 1; break; ) 

) 

else { 

line = hd la; 
pa = hd tl la; 

) 

> 

else if (n) {line = "()"; pa = hd la;) 

(n, la) = sys->tokenize(pa, ":"); 
if (n >= 2) { 

if (addressp{hd la>) addr = hd la; 

else { 

addr = Laddr; 

if {line »= nil) line » hd la; 

) 

port = hd tl la; 

} 

else { 

if (line == nil) { 
line = pa; 
addr = Laddr; 

> 

else { 

addr = pa; 

if {nuroberp(addr)) addr = Laddr; 

) 

port = default_lport; 

) 

if (line ==» "()") line = nil; 

if (Dbg > 2) sys->print (Mod+" : expand(%s> -> (%s, %s, %s)Vn". client, line, addr, port); 
return (line, addr, port); 

1 

Call.registerp(c : self ref Call) : int 
t 

if ' (c == nil) return 0; 

return start { "REGISTER" , c. state ),- 

) 

register (f rum : string, c : ref Call) : ref Call 
{ 

if (Registrar == nil) 

Registrar = Proxy; 
if (Registrar == nil) 

sys->f print {stderr, Mod+": no registar nor proxy definedNn"); 

else { 

reg := Registrar ,- 

rconn : ref Sys->Connection; 

if (c != nil && (c.registerpO || (Proxy != nil && reg == Proxy))) 

rconn = c . conn; 
if (rconn == nil) { 

(vline, vaddr, vport , net) := expandnet (reg) ; 

if (Dbg) sys->print{Mod+" : connect to %s at %s»%s»%s\n", vport. net, vaddr, vport) ; 

(ok, conn) := diaKnet, vaddr, vport, localport (f rum, vport, vaddr) >; 

rconn = ref conn; 

if (ok < 0) return nil; 

) 

callid := sid2callid(string ntime ( ) ) +"@"+Laddr; 

path ref Path(nil, viaproxy (Proxy, nil, mkvia(frum) :: nil), nil, nil); 
f rum = client_nonet (f rum) ; 
if (c != nil) { 

c = ref Call (rconn, path, frum, reg, callid, nil, "REGISTER", nil, 0, nil, 0); 

c. send (f rum) ; 

c. expire = int Exptime; 

return c .send (frum) ; 

) 

else { 

c = ref Call (rconn, path, frum, reg, callid, nil, "REGISTER" , nil, int Exptime, nil, 0); 
return c .send ( frum) ; 

} 

) 

return c; 

) 

connect (frum, tu : string, c : ref Call) : ref Call 
{ 

rconn : ref Sys->Connection; 

if (c.registerpO && Proxy nil && Proxy == Registrar) 

rconn = c.conn; 
if (rconn == nil) { 

(vline, vaddr, vport, net) := expandnet (proxy (tu) ) ; 

if (Dbg) sys->print (Mod+" : connect to %s at %s!%s!%s\n", vport, net, vaddr, vport), - 
(ok, conn) := diaKnet, vaddr, vport, localport (frum, vport, vaddr)); 
if (ok < 0) return nil; 
rconn = ref conn; 

) 

callid := sid2call id (string ntime ()) +"@"+Laddr; 

path := ref PatMnil. viaproxy (Proxy, tu, mkvia(frum) :: nil), nil, nil); 
frum = client_nonet (frxom) ; 
tu » client_nonet (tu) ; 

c » ref Call (rconn, path, frum, tu, callid, nil. "INVITE", nil, etimeO, nil, 1); 
return c .send ( frum) ; 

) 

client_nonet(s : string) : string 
{ 

(n, a, p, nil) := expandnet (s) ; 
return n+"@"+a+" : "+p; 

} 

# support 4567ei.2.3.4:tcp/5566 format 

expandnet (s : string) : (string, string, string, string) 
{ 

(n, a, p) :» expand(s); 
(net, port) := netport(p); 
return (n, a, port, net); 

> 
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ft support tcp/5060 format in proxy and client definitions 

netport(np : string) : (string, string) 

{ 

(net, p) :« expand2t(np, "/">; 
if (p != nil) np » p; 
else net = downcase (Transport) ; 
return (net, np) ; 

} 

# first port offset — avoid port numbering collision on same host 
Port_offset := 0; 

ft second port offset -- if port « the announced port 
Aport_offset := 0; 
«Aport_of fset := 30000; 

localport (client, port, taddr : string) : string 

if (Port_of fset) port = string (int port + Port_of f set) ; 
(nil, nil, cport) := expandtclient ) ; 

# we announced or already used this port -- change it 
if (cport == port || taddr == Laddr) return "l"+port; 

else if (port sip_Aport && Aport_of f set) return string (Aport_of f set + int port); 
else return port; 

} 

Call. disconnect (c : self ref Call, client : string, end : string) : ref Call 
( 

estate = end; 

if (c. session s= nil) c.session.endaudio( > ; 
c = c. send (client) ; 
c.inited = 0; 

ft This should not be need - possible bug in udp stack... 
##restartsip(client, c); 
return c; 

) 

Sipmethods : list of string; 

sipmethodp(s : string) : int 

if (Sipmethods « nil) Sipmethods = "REGISTER" :: "OPTIONS' :: -INVITE" :: "ACK" "BYE" :: "CANCEL" :: nil; 
for(l := Sipmethods; 1 != nil; 1 = tl 1) 

if (start (hd 1, s) ) return 1; 
return 0; 

} 

Call.endp(c : self ref Call) : int 
{ 

s := estate; 

return s == "CANCEL" j | s == " BYE" || start ( "BYE ", s) ; 

} 

ft Type of message sent 
ft 0 long form 
ft 1 short form 
Small := 0; 

field(f : string) : string 
{ 

if (Small) 

case f ( 

"From" => f = "f"; 

•To" => f = "t"; 

"Call-ID" => f = "i"; 

"Via" => f = "v"; 

"Content-Encoding" => f = "e"; 

"Content-Length" => f = "1"; 

"Content -Type" => f = "c"; 

•Contact" => £ = "m" ; 

■Subject" => f = "s"; 

ft discrepencies from vovida -> from LSS and 3com 
"Cseq" => f = "CSeq"; 

> 

return f; 

} 

Call. send (c : self ref Call, client : string) : ref Call 

(method, code, reason) := c.stateinf o( ) ; 
if ( ssipmethodp (method ) ) { 

sys->fprint (stderr, Mod+": unknown SIP event %s\n" , method) ; 

return nil; 

if (Dbg) sys->print (Mod+" : current state %s %d %s\n", method, code, reason); 

f rum := c. frum; 

tu := Ctu; 

callid := c.callid; 

if (c.callid nil) sys->fprint (stderr, Mod*": missing callid in call to %s\n" , tu); 

(lline, laddr, lport, nil) := expandnet (client ) ; 
(fline, faddr, fport) := expand ( frum) ; 
(tline, taddr, tport) := expand(tu); 

ft contact 
cont : string; 

if (method "ACK" && c.path != nil && c. path. contact != nil) 

cont = sipurlvaHc. path. contact) ; 
else cont » expl ici tport (laddr , lport); 

orig, dest : string; 
if (pos('0', fline) >= 0) { 
orig ■ fline; 

(fline, nil) = expand2t (fline, "©"); 

) 

else if (fline != nil) 

orig = explici tport (fline+"0"+faddr, fport); 
else orig = expl ici tport (faddr , fport); 

if (posCe', tline) >= 0) { 
dest = tline; 

(tline, nil) = expand2t (tline, "0"); 

} 

else if (tline != nil) 

dest » expl icitport(tline+"0"+ taddr, tport); 
else dest * expl ici tport (taddr, tport); 

header, data : string; 

ft This was to talk to vovida 

addp t c.inited; 
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addp = 0; 
if (icode) { 

if (c.registerp( > ) addp = 0; 

# rfc2543 line 1754 

if (method == "REGISTER" && Ldomain != nil) header += method* " sip: "+Ldomain[l: ] ; 
else header += method*" sip: "+add_lport (dest , addp); 
if (addp) header += ";user=phone" ; 
header += " 

) 

header += Version; 

if (code) header += sys->sprint ( " %d %s", code, reason) ,- 
header += "\r\n"; 
record := c .path.record; 
route := c .path. route ; 
if (record \- nil) { 

header += field ( "Record-Route" )+" : "; 
for (r := record; r i= nil; r ■ tl r) { 
header += mksipurMhd r) ; 
if (tl r != nil) header += ", 

) 

header +■ "\r\n"; 

if (route == nil) sys->f print (stderr , Mod+": missing route field with record-route\n" ) ; 

> 

if (route != nil) { 

for (r := route; r != nil; r = tl r) 

header += field( "Route" )+" : "+raksipurl (hd r)+"\r\n"; 

t compact form 

header field ( "Route" ) + " : "; 

for (r := route; r ! = nil; r « tl r) ( 

header += mksipurl (hd r); 

if (tl r 1= nil) header += "; 

} 

header += "\r\n"; 

} 

via := c. path. via; 

8 this is a response (route is on) 

if (method «■ "ACK") { 

if (Proxy ! = nil && len via < 2) { 

sys->fprint{ stderr, Mod+": response missing via field (%s)\n", method); 
via = viaproxy (Proxy, nil, mkvia(cont) :: nil); 

} 

> 

if (via != nil && tl via ! = nil) { 

if (icode && method != "ACK" ) via = tl via; 
for (; via != nil; via = tl via) 

header f ield( "Via") +■ : "+hd via+"\r\n"; 

) 

else header f ield( "Via" ) +• : ■+ mkvia (cont ) +" \r\n" ; 

# disable this now - was needed to talk to Vovida 1.7 
addp =0; 

sipo, sipd : string; 
if (code « 200 && method == "BYE" ) { 
sipo = "<sip: "+orig+">"; 

sipd = "<sip: "+add_lport (dest, addp) + " ,-user=phone>" ; 
sipd = "<sip:"+add_l port (dest, addp) +">" ; 

) 

else if (c.registerpO ) sipo = sipd = "<sip: "+orig+">" ; 
else { 

#8 sipo = f line+"_phone<sip: "+add_lport (orig, addp)+">"; 

## sipd a tline+"<sip: "+add_lport (dest, addp) +" ;user=phone>" ; 

# sipo = f line+"<sip: "+add_lport (orig, addp)+">"; 

# sipd = tline+"<sip: "+add_lport (dest, addp>+">"; 
sipo = »<sip: "+add_lport (orig, addp)+">"; 

sipd = "<sip:"+add_lport(dest, addp)+">"; 

) 

header +« f ield( "From" ) + " : "+sipo+"\r\n" ; 
header += f ield( "To" ) + " : "+sipd-»-"\r\n" ; 

t fix first time call id (now that we preserve 3) 
if (pos('@', callid) < 0) callid += "6"+faddr; 
header +» f ield{ "Call-ID" ) + " : "+ callid +"\r\n"; 
restart := 0; 
cseq := c.cseq; 

if (cseq == nil || method == "BYE") { 
seqn := 1; 

if (method == "BYE") { 
seqn++; 

if (code == 200) restart = c.inited; 

} 

cseq = string seqn+" "+method; 
c.cseq = cseq; 

} 

header += f ield("CSeq")+" : "+cseq+ "\r\n" ; 
curl : string; 

if (proxytypeO ==* "lss") curl = "<sip: "+cont+">"; 
else { 

if <pos (•»''. lline) >= 0) (lline, nil) = expand2t (lline, "0"); 
curl = "<sip: "+lline+"e"+cont+">"; 

} 

if (method != "REGISTER" ) header +- field( "Contact" )+" : "+curl+"\r\n" ; 
if (icode && method == "INVITE") { 

header +» "User-Agent: Inferno Webphone 2630\r\n"; 

header += field ( "Subject ")+" : Inferno Webphone lNVITE\r\n"; 

header += field( "Content -Type" )+" : application/sdp\r\n" ; 

) 

if (code « 200 && method == "INVITE") { 

header + » field ( "Content -Type" > + " : application/sdp\r\n" ; 

} 

if (method == "REGISTER") { 

if (!c. expire) header +=* field( "Contact" ) + " : * \r\nExpires : 0\r\n"; 
else { 

header += field ( "Contact ")+" : "+curl; 

if (Transport != "UDP") header += transport = "+downcase (Transport ) ; 
header +■ "\r\nExpires : "+string c. expire* "\r\n"; 

} 

c. expire = 0; 

} 

header +» field ("Content -Length" ) + " : "; 
csp 0; 

if ((icode || code == 200) && method « -INVITE") { 
rtpport := Rtpport; 
daddr := laddr; # was faddr 
if (code « 200) { 

rtpport • Rrtport; 
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# daddr = derive_taddr (c) ; 
} 

sid : string ,- 

if (c. session ! = nil) sid = c. session. sid; 
else sid = callid2sid(callid) ; 

data += "v=0\r\no=- "+sid+" "+sid+" IN IP4 "+daddr+"\r\n"; 

# data +- "v=0\r\no=username -+sid+" "+sid+" IN IP4 "+daddr+"\r\n"; 

# data += "v=0\r\no=username 0 0 IN IP4 "+daddr+"\r\n" ; 
data += "s=lnferno Ephone Session\r\n" ; 

# data + ■ "c=IN IP4 "+daddr+"\r\nt="+string rtime()+" 0\r\nm=audio "+rtpport+" -+Aproto+" 0\r\na=rtpmap:0 PCMU/8000\r\na=ptime:20\r\i 

# data += "c=lN IP4 ■ +daddr+ ■ \r\nt=0 0\r\nm=audio "+rtpport+" "+Aproto+* 0\r\n"; 
csp = caddsessiontsid, data); 

msg := header+string len {array of byte data) +"\r\n\r\n"+data; 

if (c.conn == nil) { 

(nil, vaddr, vport, net) := expandnet (proxy (viahost (c, c.tu, 0))); 

if (Dbg) sys->print (Mod+" : reconnect to %s at %s!%s!%s\n", vport, net, vaddr, vport) ,- 
(ok, conn) := dial (net, vaddr, vport, localport (client , vport, vaddr)); 
if (ok >= 0) c.conn = ref conn; 

} 

if (c.conn != nil) { 

if (estate == "ACK") { 

if (c .addedsessionp( ) ) csession.startaudio(O) ; 
c session. announceaudio ( ) ; 
c. session. dialaudioO ; 

) 

if (csp) ( 

c. session. startaudio(l) ; 
c. session. announceaudio () ; 

if (Vbs) sys->print (Mod+" : sending: \r\n%s\r\n" , msg); 
fd := c.conn.dfd; 

n := sys->seek(fd, 0, Sys->SEEKSTART) ; 

if (n < 0) sys->fprint (stderr, Mod+": seek %d %r\n", n) ; 
n - sys->f print (fd, "%s", msg) ; 
if (n < 0) { 

sys->f print (stderr, Mod+": sending %d %r\n", n); 
c.conn.dfd = nil; c.conn = nil; 
spawn c.resendmsg( client, msg); 

} 

else { 

if (Vbs) sys->print (Mod+" : sent: %s\r\n", estate); 
if (1) c.msg = msg; 

if (restart || estate == "BYE 200 OK" ) { 

# This should not be need - possible bug in udp stack... 
spawn restartsipO (client , c) ; 

) 

} 

else sys->fprint (stderr, Mod+": send error: mission connection\n" ) ,- 
return c; 

) 

# derive a taddr for response based on received call data 
derive_taddr (c : ref Call) : string 

{ 

taddr : string; 

(nil, tost) := expand2t (lastel (c. path, via) , " \f); 
if (taddr != nil) (taddr, nil) = expand2t { tost , ":"); 
if (taddr == nil) { 

tost = sipurlval (c. path. contact) ; 

if (tost != nil) (nil, taddr, nil) « expand ( tost ) ; 

} 

if (taddr == nil) 

(nil, taddr, nil) = expand (c . tu) ; 
return taddr; 

} 

# this was needed to work around a vovida problem 
add_lport (client : string, flag : int) : string 

{ 

if (flag) ( 

(nil, nil, p, nil) := expandnet (client) ; 
return explicitport (cl ient , p) ; 

) 

return client ; 

) 

Call -resend(c : self ref Call, client : string) 
{ 

if (restartsip (client , c)) { 
if (c.msg != nil) 

c .resendmsg (client , c.msg); 
else if (Dbg) sys->print (Mod+" : no message to resend\n"); 

) 

c.msg = nil; 

) 

restartsipO (client : string, c : ref Call) 
{ 

restartsip (client, c); 

) 

Call .resendmsg (c : self ref Call, client : string, msg: string) 
t 

if (msg != nil) { 

(nil, vaddr, vport, net) := expandnet (proxy (viahost (c, c.tu, 0))); 
if (c.conn == nil |[ c.conn.dfd == nil) { 

if (Dbg) sys->print (Mod+" : reconnect to %s at %s! %s«%s\n" , vport, net, vaddr, vport); 
(ok, conn) —dial (net, vaddr, vport, localport (client, vport, vaddr)); 
if (ok >= 0) { 

c.conn = ref conn; 
fd := c.conn.dfd; 

} 

else { 

sys->f print (stderr, Mod+": cannot resend\n"); 
return; 

) 

) 

fd := c.conn.dfd; 

n := sys->seek(fd, 0, Sys->SEEKSTART) ; 

if (n < 0) sys->fprint (stderr, Mod+" : seek %d %r\n", n) ; 
n = sys->fprint(fd, "%s", msg); 

if (n < 0) sys->fprint (stderr, Mod+": resending %d %r\n", n) ; 
else sys->fprint (stderr, Mod+" : %s resent\n", estate); 

) 

) 
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Call .addsession(c : self ref Call, sid, data : string) : int 

if (Dbg > 1) sys->print(Mod+" : adding session %s\n", data); 
if (c. session nil) 

c. session = ref Session(sid, data, nil, nil); 

else { 

s := c. session; 

if {s.sid != nil sid != nil && s.sid !■= sid) { 

sys->f print (stderr, Mod+": changing session id %s->%s\n", s.sid, sid); 
s.sid = sid; 

) 

if (s.data ==» nil) s.data = data; 
else s.rdata = data :: s.rdata, - 
return 1; 

) 

return 0; 

> 

Call .addedsessionptc : self ref Call) : int 
{ 

s :*» c. session; 

return (s != nil && s.data •= nil && s.rdata != nil) ; 

) 

Session. startaudio(s : self ref Session, tipe : int) 
{ 

datal := s.data; 
ml := retrieve ( "m=" , datal ); 
cl :=» retrieve ( "c=" , datal); 
data2, m2, c2 : string; 

if (Dbg) sys->print (Mod*" : session %s data audio : \n\t%s\n" , s.sid. ml); 
if (s.rdata •= nil) { 

if (Dbg) sys->print("\trdata audio :\n"); 

ford := s.rdata; 1 != nil; 1 = tl 1) { 
data2 = hd 1; 

m2 = retrieve ( "m=" , data2); 

c2 = retrieve ( "c = " , data2) ; 

if (Dbg) sys->print ("\t: : %s\n", m2); 

if (m2 »=» nil) break; 

} 

if <m2 != nil) { 

setupaudio (s, tipe, snth(2, cl), snthd, ml), snth(2, c2), snth(l, m2) , datal, data2); 

} 

) 

} 

debug := 0; 

setupaudio (s : ref Session, tipe : int, faddr, fport, taddr, tport, datal, data2 : string) 
{ 

if (s. audio ! = nil) { 

sys->f print (stderr, Mod+": audio already started\n" ) ; 
return; 

} 

rtcpl := int fport; 
if (irtcpl) ( 

if (tipe) fport = def ault_rtpport; 

else fport = default_rrtport ; 

) 

rtcp2 := int tport; 
if (!rtcp2) { 

if (tipe) tport = def ault_rrtport; 

else tport = default_rtpport; 

} 

ml := retrieve ( "m=" , datal); atypel := snth(2. ml) + V+snth(3 , ml); 
m2 := retrieve ( "m=" , data2); atype2 := snth(2, m2) +"/ "+snth(3, m2 ) ; 
if (start ("RTP/AVP", atypel)) rtcpl = 1 + int fport; 
if (start ("RTP/AVP", atype2)) rtcp2 = 1 ♦ int tport; 
if (atypel != atype2) { 

sys->f print (stderr, Mod+": SDP audio negotiation fail: missmatched %s and %s\n", atypel, atype2); 
if (len atypel > len atype2) atype2 = atypel; 
else atypel = atype2; 

if (Dbg) sys->print (Mod*" : start %s audio: %d %s:%s %s:%s\n\n", atypel, tipe, faddr, fport, taddr, tport); 
Size := 172; 

if (ua != nil) size = ua_seize (size, datal, data2); 

s. audio = ref Audio ( faddr+ ■: " + fport+" : "+atypel, taddr+" : " + tport+" : "+atype2, tipe, nil, nil, 0, 0, rtcpl, rtcp2, nil, nil, size, 0); 

) 

expandatype ( t : string) : (string, string, string, string) 
{ 

(ap, tp, n) := expand3t(t, "/"); 
net := "udp"; 

if (tp == "TCP") net = "tcp"; 
return (net, ap, tp, n); 

} 

Session.announceaudio(s : self ref Session) 
( 

a s. audio; 

if (a «= nil) return; 

if (a. listen) { 

sys->f print (stderr, Mod+": audio already announcedNn" ) ; 

return; 

) 

(faddr, fport, ftype) := expand3t (a.addrl , ":"); 
(netl, nil, nil, nil) := expandatype (ftype) ; 
(taddr, tport, ttype) := expand3t(a.addr2, ":"); 
(net2, nil, nil, nil) expandatype (ttype) ; 
if da. tipe) { 

if (Laddr != faddr) sys->f print (stderr , Mod+": missmatched announce on %s and not %s\n", Laddr, faddr); 
(ok, conn) :» announce (netl , "*", fport); 
if (ok < 0) ( 

sys->fprint( stderr, Mod+": cannot announce %s\n", fport); 



else { 



if (netl « "udp") a.connl = ref conn; 
ch := chan of int; 

spawn audiolistener (netl, a, conn, ch) ; 
<- ch; 

if (a. rtcpl) { 

(ok, conn) = announce (netl, "*", string a. rtcpl); 
if (ok < 0) { 

sys->fprint( stderr, Mod+": cannot announce rtcp %d\n" , a. rtcpl); 

} 

else a.cconl = ref conn; 

) 



) 

else ( 
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if (Laddr != taddr) sys->f print (stderr , Mod+": missmatched announce on %s and not %s\n", Laddr, taddr); 
(ok, conn) := announce (net2 , tport); 
if (ok < 0) { 

sys->fprint( stderr, Mod*": cannot announce %s\n", tport); 

) 

else { 

if (net2 == "udp") a.conn2 = ref conn; 
ch := chan of int; 

spawn audiol is tener(net2, a, conn, ch) ; 
<- ch; 

if (a.rtcp2) { 

(ok, conn) = announce (net2 , "*", string a.rtcp2); 
if (ok < 0) { 

sys->f print (stderr, Mod+": cannot announce rtcp %d\n", a.rtcp2); 

) 

else a.ccon2 = ref conn; 

} 



locaudioport (port : string) : string 
{ 

if (port == nil) return port; 
return string (int port + 10000); 

) 

Session. dialaudio(s : self ref Session) 
( 

a := s. audio; 

if (a == nil) return; 

if (a. speak) < 

sys->f print (stderr, Mod+": audio dial already setup\n"); 
return; 

) 

(faddr, fport, ftype) := expand3t (a.addrl , ":"); 
(netl, nil, nil, nil) := expanda type (ftype) ; 
(taddr, tport, ttype) := expand3t(a.addr2, ":"); 
(net2, nil, nil, nil) :* expanda type (ttype) ; 
if (Ja.tipe) { 

ch := chan of int; 

(ok, conn) ;= dial (net 2, taddr, tport, locaudioport (tport) ) ; 
if (ok < 0) { 

sys->f print (stderr, Mod+": cannot dial %s%s\n- , taddr, tport); 



} 

else { 



) 

else { 



a.conn2 ■ ref conn; 

spawn audiospeak(a, conn.dfd, ch) ; 

<-Ch; 

if (a.rtcp2) { 

(ok, conn) = dial(net2, taddr, string a.rtcp2, locaudioport (string a.rtcp2)); 
if (ok < 0) { 

sys->f print (stderr, Mod*": cannot dial %s%d\n", taddr, a.rtcp2>; 

} 

else a.ccon2 = ref conn; 

} 



ch := chan of int; 

(ok, conn) := dial (netl, faddr, fport, locaudioport (fport) ) ; 
if (ok < 0) { 

sys->f print (stderr, Mod+": cannot dial %s%s\n", faddr, fport); 



) 

else { 

a.connl = ref conn; 

spawn audiospeak (a, conn.dfd, ch) ,- 

<-Ch; 

if (a.rtcpl) { 

(ok, conn) =dial(netl, faddr, string a.rtcpl, locaudioport (string a . rtcpl )) ; 
if (ok < 0) { 

sys->f print (stderr, Mod+": cannot dial %s%d\n", taddr, a.rtcpl); 

) 

else a.cconl = ref conn; 

) 

) 

) 

audiolistenertnet : string, a : ref Audio, c : Sys->Connection, ch : chan of int) 
( 

if (net -udp') { 

audiolisten(a, c.dfd, ch); 
return; 

) 

ch <- = a. listen * sys->pctl(0, nil); 
pl := 0; 

while (a. listen) { 

(ok, nc) := sys->listen(c) ; 
if (ok < 0) ( 

sys->fprint (stderr, Mod+": listen: %r\n"); 

a. listen = 0; 

return; 

) 

buf := array [64] of byte; 

1 := sys->open (nc .dir+"/remote" , sys->OREAD) ; 
n := sys->read(l, buf, len buf); 
if(n >= 0) 

if (Dbg) sys->print (Mod+" : new audio (%s) : %s %s'. Mod, nc.dir, string buf[0:nj); 

nc.dfd = sys->open (nc.dir* "/data", sys->OREWR) ; 
if{nc.dfd nil) { 

sys->f print (stderr, Mod+": open: %s: %r\n" , nc.dir); 

a. listen = 0; 

return; 

> 

if (pi) { 

kill(pl); 

if (Dbg) sys->print (Mod+" : kill previous audiolisten %d\n", pi); 

) 

a.connl = ref nc; 

nch := chan of int; 

spawn audiolisten (a, nc.dfd, nch); 

pi = a. listen = <- nch; 

# expect only one attempt for now' 

return; 



) 

ft Sync is used for loop back test of ephone 
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# from an emulation version where ua is nil 
Sync : chan of array of byte; 

audiolistenta : ref Audio, fd : ref Sys->FD, ch : chan of int) 
{ 

ok : int; err : string; 

ch <- => a. listen = sys->pctl(0, nil); 

if Ha.size) { 

sys->fpr int (stderr, Mod+ ": null buffer size\n"); 

return; 

} 

buf := array (a .size) of byte; 

if (Dbg) sys->print (Mod+" : audiolisten start size %d\n", a. size) ; 
cnt := 0; fnt : = 0; 
while(a. listen) { 

n :« sys->read(fd, buf, len buf); 
if (n < 0) return; 
else if (n == 0) continue; 
else if (ua •= nil) { 

if (a.tipe && la.busy) { 

if (Dbg) sys->print(Mod+" : audio now busy = %d\n" , n) ; 
a. busy = n; 

} 

(ok, err) = ua->playFrame (buf [0 : n] ) ; 
if (ok < 0) break; 

else if (Dbg > 1 && cnt++ > 1000) { 

sys->print (Mod+" : playFrame %dk len %d\n", ++fnt, n); 
cnt = 0; 

) 

} 

# This is the emu to emu sip client test 

else if (n < 30) sys->print (Mod+ " : hear: %s\n" , string buf [0:n] ) ; 

# This is the ephone to emu loopback test 
else { 

if (Sync == nil) Sync = chan of array of byte; 

Sync <- = buf[0:n}; 

if (Dbg && cnt++ > 1000) { 

sys->print (Mod+" : buf len ftd\n", n) ; 

cnt = 0; 

) 

> 

) 

if (Dbg) sys->print (Mod+" : audiolisten end\n" ) ; 

if (ok < 0) sys->fprint (stderr, Mod+": %s\n", err) ; 

> 

audiospeak(a : ref Audio, fd : ref Sys->FD, ch : chan of int) 
{ 

ch <- = a. speak = sys->pctl(0, nil); 
if (la. size) { 

sys->fprint (stderr, Mod+": null buffer size!\n"); 

return; 

} 

buf : array of byte; 
ok := 0; err : string; 
if (ua == nil) ( 

(faddr, fport, nil) := expand3t(a.addrl, ":"); 

(taddr, tport, nil) := expand3t (a.addr2, ":"); 

if (a.tipe) err = f addr+ ■ : "+fport; 

else err = taddr +" : "+tport; 

buf = array of byte ("test from "+err) ; 

ok = len buf; 

) 

if (ua != nil) buf = array (a .size) of byte; 
cnt := 0; fnt := 0; 

if (Dbg) sys->print(Mod+" : audiospeak start size %d\n", a.size); 
wait := ua != nil && a.tipe; 
while (a. speak) ( 

if (ua != nil) { 

(ok, err) = ua->recordFrame (buf ) ; 
if (ok < 0) break; 

else if (Dbg > 1 && cnt++ > 1000) { 
cnt = 0; 

sys->print (Mod+" : recordFrame %dk len %d\n" , ++fnt, ok) ; 

) 

if (wait && a. busy) wait = 0; 

} 

# This is the emu to ephone loopback test 
else if (Sync !■ nil) buf = <- Sync; 

# wait for far end to speak first (proxy issue) 
if (wait) continue; 

n := sys->write(fd, buf, ok) ; 

if (n < 0) return; 

else if (n == 0) continue; 

# This is the emu to emu sip client test 
else if (n < 30) { 

sys->print (Mod+" : speak: %s\n", string buf [0 :n) ) ; 
sys->sleep(2000) ; 

> 

} 

if (Dbg) sys->print (Mod+- : audiospeak end\n" ) ,- 

if (ok < 0) sys->fprint( stderr, Mod+": %s\n", err); 

> 

Session. endaudio(s : self ref Session) 

if (s == nil) return; 
a := s. audio; 
if (a != nil) ( 

if (Dbg) sys->print (Mod+" : stop audio: %d %s %s\n\n", a.tipe, a.addrl, a.addr2); 

pidl := a. listen; 

pid2 := a. speak; 

a. listen = 0; 

a. speak = 0; 

sys->sleep (200) ; 

kill (pidl) ; 

kill (pid2) ; 

# should not be needed - gc does it 

if (a.connl i= nil) {a.connl.dfd = nil; a.connl = nil;) 
if (a.conn2 != nil) {a.conn2.dfd = nil; a.conn2 = nil;) 
if (a.cconl != nil) {a.cconl.dfd = nil; a.cconl = nil;) 
if (a.ccon2 != nil) {a.ccon2.dfd = nil; a.ccon2 = nil;) 
if (ua != nil) ua__release ( ) ; 

) 

s. audio = nil; 



Idkey : con 22e+07; 
sid2callid(sid : string) : string 
( 
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return string (int sid - int Idkey): 

) 

callid2sid(cid : string) : string 
{ 

return string (int cid | int Idkey); 

} 

* Preset the audio connections for rtp/tcp tunnelling 

Aconn2 : adt 
{ 

tcpcl : Sys-Connection; 
tcpc2 : Sys - Connection ; 

); 

Audio2 : ref Aconn2; 
tcpaudio ( ) 

if (Aproto == "RTP/TCP" && Audio2 »» nil) { 

(nil, tcpl) := announce ( "tcp" , "*", Rtpport); 
(nil, tcp2) := announce! "tcp", "*", Rrtport) ; 
Audio2 ~ ref Aconn2(tcpl, tcp2); 

} 

) 

tcpclear ( ) 
{ 

Audio2 = nil; 

> 

announce (net, addr, port : string) : (int, Sys -Connection) 
{ 

if (net == "tcp" && Audio2 != nil) { 

if (Dbg) sys->print (Mod+" : tcp mode with Audio2 present port %s\n", port); 

if (port == Rtpport) return (0, Audi o2 . tcpcl ) ; 

else if (port == Rrtport) return (0, Audio2 . tcpc2) ; 

} 

ur := net*" ! "+addr+" ! "*port; 
(ok, conn) := sys->announce (ur ) 

if (ok < 0) { 

sys->fprint(stderr, Mod+": cannot announce at %s %r\n" , ur); 
return (ok, conn) ; 

} 

# open the data file for the connection 
if (net == "udp") { 

conn.dfd = sys->open(conn.dir+"/data" , sys->ORDWR) ; 
Sconn.dfd = sys->open ( conn. dir+" /data" , sys->0READ) ; 

if (conn.dfd « nil) { 

sys->f print (stderr, Mod+": cannot open file %s/data: %r\n", conn.dir); 
return (-1, conn); 

) 

if (Dbg) sys->print(Mod+" : announced fts %s port %s\n", ur, conn.dir, port); 
return (ok, conn); 

) 

listen (client : string, conn : Sys -Connect ion, ch : chan of int) 
{ 

case Transport { 

•UDP" => { 

cl := ref Client (client, 0, 0, 0); 
ch <- = active = sys->pctl(0, nil); 
cl .listen (ref conn, nil); 

} 

* => listener (client, conn, ch); 

> 

) 

listener (client : string, c : Sys -Connect ion, ch : chan of int) 

if (Dbg) sys->print (Mod+ " : start tcp listener\n" ) ; 
if (ch != nil) ch <- = active = sys->pctl(0, nil); 
else active = sys->pctl(0, nil); 
cl := ref Client (client, 0, 0, 0); 
while (active) { 

(ok, nc) := sys->listen(c) ; 
if (ok < 0) { 

sys->f print (stderr, Mod+": listen: %r\n"); 

active = 0; 

continue; 

) 

buf := array[64] of byte; 

1 := sys->open(nc.dir+" /remote", sys->OREAD> ; 
n := sys->read(l, buf, len buf); 
if (n >= 0) 

if (Dbg) sys->print (Mod+": new request (%s) : %s %s". Mod, nc.dir, string buf[0:n]); 

nc.dfd = sys->open(nc.dir+"/data", sys->0RDWR) ; 
if (nc.dfd == nil) { 

sys->f print (stderr, Mod+": open: %s: %r\n", nc.dir); 

active = 0; 

return; 

} 

cl. active = 0; 
» kill(cl.pid); 

cl = ref Client (client, 0, 0, 0) ; 

spawn cl. listen (ref nc, nch :« chan of int); 

<- nch; 

Clist « cl : : Clist; 

) 

> 

Client : adc 
{ 

url : string; 
pid : int; 
active : int; 
time : int; 

listen : fn(cl : self ref Client, conn : ref Sys -Connect ion, ch : chan of int); 

); 

Clist : list of ref Client; 

Client .listen(cl : self ref Client, conn : ref Sys -Connect ion, ch : chan of int) 
( 
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client := cl.url; 

(line, address, port) expand (client ) ; 
cl. active = cl.pid = sys->pctl(0, nil); 
if (ch • = nil) ( 

ch <- « cl.pid; 

cl.time = timet) ; 

if (Dbg) sys->print(Mod+" : spawn listen process %d\n", cl.pid); 

} 

fd : = conn.dfd; 

buf := array {102 4] of byte; 

while (active && cl. active) { 

if (cl.time) cl.time = timet); 

n := sys->seek(fd, 0, Sys->SEEKSTART) ; 

if (n < 0) sys->f print (stderr, Mod+": seek %d %r\n", n) ; 
n - sys->read(fd, buf, len buf); 
if (n < 0) ( 

sys->f print (stderr, Mod+": receiving %d %r\n", n) ; 
cl. active = 0; 
continue ; 

} 

if (n > 0) { 

csp := 0; 

if (Vbs) sys->print (Mod+" : receiving: \n" ) ; 

(hi, data) := decode (string buf[0:n]); 

c := mkcalKhl, data) ; 

cp := C. f ind(c.callid) ; # was C.this 

if (cp != nil) { 

if (cp. expire == 0 | | timeO < cp. expire) cp. expire = 0; 

if (cp. state == "INVITE 180 Ringing- && estate == "INVITE") { 

sys->fprint (stderr, Mod+": received a dupplicate INVITE\n"); 

spawn cp.resend( client) ; 

continue; 

) 

cp. store (c) ; 

if (c. session l- nil) 

csp = cp.addsession(c . session. sid, c. session. data ) ; 

c - cp; 

if (C.this != nil && C.this.callid J= c.callid) 

if (Dbg) sys->print (Mod+" : switching to received call %s->%s\n", C.this.callid. c.callid); 
C.recv = c; 

) 

else ( 

C.recv = c; 

if (C.this != nil) 

if (Dbg) sys->print(Mod+" : switching to new received call %s->%s\n", C.this.callid, c.callid); 

) 

C.take(c) ; 

if (cp != nil && cp.endpO) ( 
c = cp; 

c.nextstate (client) ; 
c . session . endaudio ( ) ; 
C.rem(cp) ; c = nil; 

) 

else if (C.recv != nil C.recv. endp( ) ) { 
c = C.recv; 
c .nextstate (client) ; 
c . session . endaudio ( ) ; 
C. rem (C.recv) ; c = nil; 

> 

else if (c != nil) { 

if (c.conn == nil) { 

(nil, vaddr, vport, net) := expandnet (proxy (viahost (c, c.frum, 1))); 
if (vaddr == Laddr && vport == port) { 

if (Dbg) sys->print (Mod+" : will not connect to self %s!%s\n", vaddr, vport); 

C.rem(c); 

continue; 

} 

if (Dbg) sys->print(Mod+" : connect back to %s at %si%s!%s\n", vport, net, vaddr, vport); 
(ok, conn) := dial (net, vaddr, vport, localport (client , vport, vaddr)); 
if (ok >= 0) c.conn = ref conn; 

else sys->fprint (stderr, Mod+": connect failed\n"); 

} 

# C . take { c ) ; C . recv = c ; 

if (estate "ACK") { 

if (c.addedsessionpO ) c. session. dialaudioO ; 

else sys->fprint (stderr, Mod+": audio setup is missing\n"); 

) 

else if (csp) ( 

if (Dbg) sys->print (Mod+" : will start audio next...\n"); 
Sch <- = ("", 0); 

} 

c.nextstate(client) ; 

) 

) 

) 

Cl .pid * 0; 

> 

cleanClist(f : int) 
{ 

r : list of ref Client; 
for (1 := Clist; 1 !« nil; 1 ■ tl 1) { 
Cl :» hd 1; 

if (f || cl. active == 0) { 

if (cl.pid != 0) kill(cl.pid); 

) 

else r = cl : : r ; 

} 

Clist = r; 



viahost (c : ref Call, default : string, rev : int) : string 
{ 

vhost := default; 
transport := Transport; 
if (c. path. via == nil) ( 

if (c. path. contact i= nil) vhost = c. path. contact; 

if (rev) 

sys->f print (stderr , Mod+": error received empty via field - using %s\n", vhost); 
else if (Dbg) sys->print (Mod+" : via () - using %s\n", vhost); 

} 

else { 

proto : string; 

(proto, vhost) = expand2t(hd c. path. via, " \t"); 
if (Dbg) sys->print (Mod+" : via host %s\n", vhost); 
tp := snth_token(2, proto, "/"); 
if (tp == nil) { 

sys->f print (stderr, Mod+": unexpected transport protocol %s in via field\n", proto); 

} 
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else transport * tp; 

) 

(n, a, p) := expand (vhost > ; 

r := »e»+a+" : "+downcase( transport ) +"/"+p; 

if (Dbg) sys->print(Mod+": viahost returns %s\n", r); 

return r; 

) 

Call.nextstatetc : self ref Call, client : string) 
< 

case estate { 

" INVITE" => { 

estate +=» " 180 Ringing"; 
Sch <- = <"r", -1) ; 
c send (client) ; 

) 

# "INVITE 180 Ringing" => { 

# estate = "INVITE 200 OK"; 

# c.send(client) ; 

# ) 

" INVITE 200 OK" => { 

estate = "ACK"; 
e send (client) ; 

} 

# "ACK" => { 

I estate = "BYE"; 

# e send (client) ; 
I ) 

"BYE" «> { 

estate += • 200 OK"; 
Sch <- = ("". 0) ; 
c . send (client) ; 

) 

"CANCEL" => Sch <~ = <"", 0); 
* => { 

(method, code, reason) := e stateinf o( ) ; 
if (code < 300) { 

sys->fprint (stderr, Mod+": state %s %d %s\n". method, code, reason); 



} 

else { 



if (code >= 400) 

sys->fprint (stderr, Mod+" : error state %s %d %s\n", method, code, reason); 
else if (code >= 300) 

sys->f print (stderr, Mod+": ignored state %s %d %s\n", method, code, reason); 
C.rem(c) ,- 



Path : adt 
( 

contact : string; 
via : list of string; 
route : list of string; 
record : list of string; 

>; 

mkpathU : list of string) : ref Path 

contact := nonull (findlval ("Contact : " :: "m:" :: nil, 1, 0>); 
via := nolnull (f indlall ( "Via: " : : "v:' :: nil, 1, 0)); 
if (Dbg > 1) 

if (via != nil) sys->print (Mod+" : via (%s . len %d)\n", hd via, len via); 

else sys->print(Mod+»: via ()\n"); 
I (nil, route) := sys->tokenize (nonull (findval ("Route: ", 1, 0)), ".">; 

route := nolnull (findalU "Route: ", 1, 0)); 
if (route != nil) { * 

route = sipurls (route) ; 

if (Dbg > 1) 

sys->print (Mod+" : route (%s . len %d)\n", hd route, len route); 

# (nil, record) :=■ sys->tokenize (nonull ( findval ( "Record-Route: " , 1, 0)), ","); 

record := nolnull ( findall ( "Record -Route: " , 1, 0) ) ; 
if (record «= nil) { 
if (Dbg > 1) 

sys->print (Mod+" : record-route (%s . len %d)\n", hd record, len record) ; 
if (route == nil) { 

recurls := sipurls (record) ; 

if (contact == nil || findl (sipurlval (contact) , recurls)) route = reverse (record) ; 
else route = reverse (mksipurl (contact) :: record); 

) 

return ref Path(contact , via, route, record); 

) 

mksipurl (s : string) : string 
{ 

s = trimspace(s) ; 
if (s == nil) { 

sys->fprint (stderr, Mod+": bad () argument to mksipurl\n" > ; 
return nil; 

if (start ("<". s) || start ("sip:", s>> return s; 
else return "<sip: "+s+">" ; 

} 

trimspacets : string) : string 
{ 

a := 0; b : = len s; 
for(i := 0; i < b; i++) 

if (sti] == ' ' || sli] == '\t') a*+; 

else break; 
for(i = b -1; i > a; i--> 

if (s[il =« ' ' | | s(i] == «\f) b = i; 

else break; 
return s[a:b] ; 

> 

mkcalld : list of string, data : string) : ref Call 

(nil, 11) :» sys -> token izethd 1, • \t"); 
state, substate : string; 
if (11 •» nil) ( 

state = hd 11; 

fordl o tl 11; 11 != nil; 11 = tl 11) 
substate +» " "+ hd 11; 

) 

cseq := nonull (findval ("CSeq:", 1, 0)); 
(nil, 11) » sys->tokenize(cseq. ■ \t"); 
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if (11 != nil) { 

if (start ( "SIP/ " , state)) ( 
if (tl 11 !« nil) 

state = hd tl 11; 

) 

cseq = 12string(ll) ; 

if (Dbg > 2) sys->print (Mod+ ■ : cseq=%s\n", cseq) ; 

if {! start (" sip:", substate) ) 

state += substate; 

path : = mkpath ( 1 ) ; 

frum := sipurlval(findlval("From:" :: "f:" :: nil, 1, 0)); 
tu := sipurlval (f indlval ("To: " :: "t:" :: nil, 1. 0)); 
callid := nonull (findlval ("Call-ID:" :: "i:" :: nil, 1, 0)>; 
if (callid != nil) { 
# (nil, 11) = sys->tokenize (callid, " \t@"); 

# keep the 0 on for Iss sip proxy 

(nil, 11) = sys->tokenize (callid, " \f); 

if (11 != nil) callid = hd 11; 

) 

sid : string; 

if (data != nil) { 

pi : = find("o=»", data); 

if (pi < 0) pi « 0; else pi = posst" \t", data, pi); 
if (pi < 0) pi = 0; 

p2 := poso('\n', data, pi); if (p2 < 0) p2 = 0; 
, (nil, 11) = sys->tokenize(data[pl:p2) , " \t\r\n"); 
if (11 != nil) sid = hd 11; 

if (Dbg) sys->print(Mod+" : received sid = %s\n", sid); 

) 

s : ref Session; 
if (sid != nil) 

s = ref Session (sid, data, nil, nil); 
return ref Call (nil, path, frum, tu, callid, cseq, state, s, 0, nil, 0); 



sipurlsd : list of string) : list of string 
return reverse ( revsipurls (1) ) ; 



revsipurls (1 : list of string) : list of string 
{ 

r : list of string; 
fort; 1 !=■ nil; 1 = tl 1) 

r = sipurlval (hd 1) :: r; 
return r; 



sipurlval_(s : string) : string 
{ 

su := "<sip:"; 

pi := f ind(su, s) ; 

if (pi < 0) return nil; 

else pi += len su; 

p2 := poso( '>' , s, pi) ; 

if (p2 < 0) p2 = len s; 

else ++p2; 

rs := s[pl :p2] ; 

if (rs != nil) { 

rl := len rs; 

if (rs[rl -1] == '>') { rl — ; rs = rs{0:rl]; } 

else sys->fprint (stderr, Mod+": sipurl missing > at end of: %s\n" , rs); 
if (Dbg > 1) sys->print(Mod+" : sipurl: %s\n", rs); 

} 

return rs; 



sipurlval (s : string) : string 
( 

rs sipurlval_(s) ; 

if (rs != nil) return rs; 

su := "sip:"; 

pi := f ind(su, s) ; 

if (pi < 0) return nil; 

else pi += len su; 

p2 := poss(", \t", s, pi); if (p2 < 0) p2 = len s; 
rs = s[pl:p2}; 
if (rs != nil) { 

(nil, 1) := sys->tokenize(rs, ■;"); 

if (Dbg > 1) sys->print(Mod+" : sipurl: %s\n", hd 1); 
return hd 1; 

) 

return rs; 

) 

decode (s : string) : (list of string, string) 
{ 

r : list of string; 

data : string; 

p, pn, n : int = 0; 

if (Vbs) sys->print("{") ; 

while ((p = poso('\r', s, n) ) >= 0 || (pn = poso('\n', s, n) ) >= 0) ( 
if (pn) p = pn; 
if (p > n) r = S{n:p] : : r; 

si := nonull (get val( "Content-Length: ", s(n:p], 0)); 
if (si nil) si = nonull (getval ( "L: " , s(n:p), 1)); 
nc := '\n*; 
if (pn) { 

nc = ' \r' ; 

pn = 0; 

) 

if (len s > p+1 && s(p+l) == nc) p++; 
if (Vbs) sys->print("%s", s[n:p+l]); 
n ■ p ■ p +1; 
if (si != nil) { 

1 :s int si; 

data » s{n:n+l] ; 

if (Vbs) sys->print("%s\r\n\r\n", data); 
break; 

) 

} 

if (Vbs) sys->print("J\r\n-); 
return (reverse(r), data); 



dial (net, addr, rport, port : string) : (int, Sys- Connection) 
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^ 

if (net != "udp") port = nil; 

(ok, conn ) := sys->dial (net+" ! "+addr+" ! "+rport, port) ; 
if (ok < 0) ( 

sys->fprint (stderr, Mod+": cannot connect to %s!%s!%s %s\n", net, addr, rport, port); 
return (ok, conn) ; 

if (Dbg) sys->print (Mod+" : new connection to %s!%s!%s %s\n", net, addr, rport. port); 
return (ok, conn) ; 

> 

# string and list utils 

12string(ll : list of string) : string 
{ 

r : string ,- 

for(;ll != nil; 11 = tl 11) { 

r +« hd 11; if (tl 11 != nil) r += " " ; 

) 

return r; 

) 

lasteKl : list of string) : string 
{ 

for (; 1 != nil; 1 = tl 1) 

if (tl 1 == nil) return hd 1; 
if (1 »= nil) return hd 1; 
return nil; 

> 

snth(n: int, s : string) : string 
{ 

(nil, 1) := sys->tokenize(s, " \t\r\n"); 
return nth(n, 1) ; 

} 

snth_token(n: int, s, t : string) : string 
{ 

(nil, 1) := sys->tokenize(s, t); 
return nth(n, 1) ; 

} 

nth(n: int, 1 : list of string) : string 
{ 

ford := 0; 1 != nil; 1 = tl 1) { 
if (i — n) return hd 1; 
i++; 

} 

return nil; 

) 

expand2(s : string) : (string, string) 
{ 

return expand2t(s, ":*); 

> 

expand2t(s, t : string) : (string, string) 
{ 

(n, 1) := sys->tokenize(s, t); 
if (1 != nil) 

if (tl 1 != nil) 

return (hd 1, hd tl 1); 

else return (hd 1, nil); 
return (nil, nil); 

} 

expand3t(s, t : string) : (string, string, string) 
{ 

(n, 1) := sys->tokenize(s, t); 
if (1 != nil) 

if (tl 1 != nil) 

if (tl tl 1 nil) 

return (hd 1, hd tl 1, hd tl tl 1); 

else 

return (hd 1, hd tl 1, nil); 
else return (hd 1, nil, nil); 
return (nil, nil, nil) ; 

} 

retrieve (k, s : string) : string 
( 

p : = f ind ( k , s ) ; 
if (p >= 0) { 

z := poso('\r', s, p) ; 

if (z < p) z = poso('\n', s, p); 

if (z < p) z = len s; 

return s{p:z] ; 

} 

return nil; 



# blank string are nil 
nonull (s : string) : string 

if (possnotC \t", s, 0) < 0) return nil; 
return s; 



nolnulld : list of string) : list of string 

r : list of string; 

for (; 1 != nil; 1 = tl 1) 

if (nonull (hd 1) != nil) r = hd 1 :: r; 
return reverse ( r ) ; 



pos(e : int, s : string) : int 

for(i := 0; i < len s; i++) 

if (e « s[i]) return i; 
return -1; 



posnot(e : int, s : string) : int 

ford := 0; i < len s; i++) 

if (e != s[i]) return i; 
return -1; 
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posstt : string, s : string, o : int) : int 
{ 

if <o < 0) o = 0; 

for(i := o; i < len s; i++) 

for <j :» 0 ; j < len t; j ++) 

if U(j] == sfi]> return i; 

return -1; 

> 

possnottt : string, s : string, o : int) : int 
{ 

if (o < 0) O = 0; 

for(i := o; i < len s; i + +) 

for (j :« 0 ; j < len t; j + + ) 

if (tt j] »■ sli] > return i; 

return -1; 

) 

find(e, s : string) : int 
{ 

for(i := 0; i < len s - len e; i++) ( 
ok := 1; 

for (j := 0; j < len e; j++) 

if <e[j] != sfi+j]) {ok = 0; break;) 
if (ok) return i; 

} 

return -1; 

} 

findvaKk : string, 1 : list of string, mc : int) : string 
r : string; 

fort; 1 != nil; 1 = tl 1) 

if Ur «* getvaKk, hd 1, mc) ) != nil) break; 
return r; 

findlvaKkl : list of string, 1 : list of string, mc : int) : string 
r : string; 

fori; 1 I- nil; 1 ■ tl II 

if Ur = getlvaKkl, hd 1, mc)) ! = nil) break; 
return r; 



iindalKk : string, 1 : list of string, mc : int) : list of string 

r : list of string; 
for(; 1 != nil i 1 = tl 1) 

if (te := getvaKk, hd 1, mc)) ! = nil) r - e :: r; 
return reverse (r); 



indlalKkl : list of string, 1 : list of string, mc : int) : list of string 

r : list of string; 

for(e ;= ""; 1 != nil; 1 = tl 1) 

if ( (e = getlvaKkl, hd 1, mc>) != nil) r = e :: r; 
return reverse (r) ; 



:indl(e : string, 1 : list of string) : int 

for(; 1 nil; 1 = tl 1) if (e == hd 1) return 1; 
return un- 



reversed : list of string) : list of string 
r : list of string; 

for(; 1 != nil; 1 = tl 1) r = hd 1 r; 
return r; 



posotc : int, s : string, o : int) : int 

forti := o; i < len s; i++) 

if (s{i] c) return i; 
return -1; 



start (k, s : string) : int 

if (len s >= len k && k == s[0:len k] ) 

return 1; 
return 0; 



t mc - 1 to match case 

getvaKk, s : string, roc : int) :string 

if (len s < len k) return nil; 
if (mc) ( 

if (k == s(0:len k] ) return s[len k:]; 

} 

else { 

if (equalp(k, s(0:lenk])) return s [len k: ) ; 

) 

return nil; 

) 

getlvaKkl : list of string, s : string, mc : int) : string 
I 

for (; kl != nil; kl = tl kl > 

if ((r := getvaKhd kl, s, roc)) != nil) return r; 
return nil; 

> 

equalptx, y : string) : int 
{ 

if (len x lo len y) return 0; 
for (i 0; i < len x; i + + ) 

if <cupcase(x[i] ) != cupcase (y [i] ) ) return 0; 
return 1; 

) 

cupcase (c : int) : int 
{ 

if fa' <= c && c <= 'z') return c + 'A' - 'a'; 
else return c; 
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downcase(s : string) : string 
{ 

for (i := 0; i < len s; i+ + ) { 
c := s[i); 

if {'A* <= c && c <=* 'Z') s[i] = c + 'a' - 'A*; 

} 

return s; 

} 

upcase(s : string) : string 

for (i := 0; i < len S; i++) { 
c := s[i]; 

if ('a' <= c && c <= 'z') s[i) - c + 'A' - 'a'; 

} 

return s; 

} 

# Read list from file 

readlisttpath : string) : list of string 
( 

(ok, dir) := sys->stat (path) ; 
if (ok < 0) { 

sys->f print (stderr, Mod+": stat %s: ftr\n", path) ,- 

return nil; 

> 

shfd := sys->open(path, sys->OREAD) ; 
if (shfd " nil) { 

sys->fprint (stderr, Mod+ ■ : open %s: %r\n", path); 

return nil; 

) 

lc := dir. length; 

if (lc == 0) return nil; 

buf := array [lc] of byte; 
m := 0; n : = lc; 

while ((n = sys->read(shfd, buf[ra:], lc - m) ) > 0) 

m +* n; 
if (n < 0) { 

sys->f print (stderr, Mod+ " : read %s: %r\n", path); 
if ( im) return nil; 

if (Dbg > 4) sys->print (Mod+" : buf (%d] =%s\n" , m, string buf); 
(nil, r) := sys->tokenize (string buf 10 :m] , " \t\r\n"); 
return r; 

} 

writelist(path : string, 1 : list of string) 

fd := sys->open(path, Sys->0WRITE| Sys->OTRUNC) ; 
if (fd == nil) 

fd = sys->create(path, Sys->ORDWR, 8r666); 
if (fd == nil) ( 

sys->f print (stderr, Mod+ ' : %s: %r\n" , path); 

return; 

) 

sys->seek(fd, 0, Sys->SEEKSTART) ; 
for (; 1 1= nil; 1 = tl 1) 

sys->fprint(fd, "%s\n - , hd 1); 

} 

# Append to file 

f append (path : string, more : string) 
{ 

fd := sys->open(path, Sys->OWRITE) ; 
if (fd == nil) 

fd = sys->create (path, Sys->ORDWR, 8r666); 
if (fd == nil) { 

sys->fprint (stderr, Mod+": %s: %r\n" , path); 

re turn, - 

) 

sys->seek(fd, 0, Sys->SEEKEND) ; 
sys->f print (fd, "%s\n", more); 

} 

####### Shannon ephone specific code ####### 

# Keypad access on shannon ephone 

Dupdsp : con "dsp2mp_dup" ; 

listenkeys (ch: chan of int) 
{ 

ch <- = Epid = sys->pctl(0, nil); 

# Checking for a non existing /dev entry after UCBaudio causes kernel dump! 
fd := sys->open( " / tmp/ *+Dupdsp, sys->OREAD ); 

# if Watch provides a dupplicate channel - use it first 

# else open the DSP device 
if (fd == nil) ( 

fd = sys->open( •/dev/dsp2mp" , sys->OREAD ); 

if (Dbg) sys->print (Mod+" : using /dev/dsp2mp\n" ) ; 

) 

else 

if (Dbg) sys->print (Mod+" : using /tmp/%s from Watch. \n" , Dupdsp); 

if(fd == nil) ( 

sys->f print (stderr, Mod+": cannot open /dev/dsp2mp\n" ) ; 
return; 

> 

sfd := sys->open(mp+"/"+sipsrv, Sys->0WRITE) ; 
if (sfd == nil) { 

sys->f print (stderr, Mod+": open %s/%s: %r\n", mp, sipsrv) ; 

return; 

> 

keywatch(fd, sfd); 

) 

keywatch(fd, sfd : ref Sys->FD) 
( 

I See shannon/ appl/t el/ watch. m 

DSP_KEYPRESS : con 68; 

# HSET_IN_USE_MSG : con 'o'; 
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# HSET_NOT_IN_USE_MSG : con 'p' ; 
HSIU : con 'o'; 
HSNIU : COn 'p'; 

SPKIU : con »s'; 

SPKNIU : con 't' ; 

hsiu := 0; 

spkiu := 0; 

buf := array 1 64] of byte; 
n := 0; 

while (Epid) { 

n = sys->read(fd, buf, len buf); 
if (n <= 0) continue; 
case int buf[0] { 
HSiu => { 

hsiu = 1; 

if (!spkiu) machine (sfd, "a"); 

} 

SPKIU => ( 

spkiu = 1; 

if <!hsiu) machine (sfd, "a"); 

} 

HSNIU => < 

hsiu = 0; 

if (!spkiu) machinetsfd, "z"); 

) 

SPKNIU => { 

spkiu = 0; 

if (!hsiu) machine (sfd, "z"); 

} 

DSP_KEYPRESS => 

if (keydigitp(c := int buf[l])> machinetsfd, sys->sprint ( "%c" , c)); 

} 

if (Dbg) sys->print (Mod+" : listenkeys: keywatch end\n" ) ; 

} 

keydigitptc : int) : int 

return (c >= '0' && c <= '9') || c == '#' | | c == ' * ' | | c == 'f ' ; 

} 

# Shannon ephone sound effect FSM 

State : adt 
{ 

s : string; 
d : string; 
c : int; 
f : string; 

}; 

# Default digits collected 
Digcnt := 4; 

Call .activep(c : self ref Call) : int 
{ 

if (c == nil) return 0; 

(t, n, m) := c.stateinfoO ; 

return t != "REGISTER" && (n >= 0 && n < 300); 

) 

S : ref State; 

machine (fd : ref Sys->FD, c : string) 

if (S == nil) S = ref State(nil, nil, 0. nil); 
if (Dbg) sys->print(Mod+": key %s\n", c) ; 
Sch <- = ("", 0) ; 
case c { 

-a- => { 

S.S a c; 

if (C.recv.activepO jj C. this.activepO ) { 
fprints (fd, S.s) ; 
S.c = 0; 
S.d = nil; 
S.s » "ok"; 

} 

else t 

S.c = Digcnt; 
Sch <- = (c, -1) ; 

) 

) 

"#" => { 

if (S.s == "a") { 

S.c = Digcnt; 
S.d = nil; 

Sch <- = (c, Times) ; 
sys->sleep (100) ; 

) 



1 



=> { 

S.s = "z"; 

S.c = 0; 

S.d ~ nil; 

Sch <- - ( "", 0) ; 

fprints (fd, S.s); 



if (S.s == "a") { 

S.d += c; S.C--; 
Sch <- = (C Times) ; 
sys->sleep(100) ; 
if (!S.c) { 

Sch <- = ("", 0); 



fprintstfd, S.s+" 
S.s = "invite"; 



} 

} 

} 

) 

fprints (fd : ref Sys->FD, s : string) 
{ 

b := array of byte s; 
sys->write(fd, b, len b) ; 



# Audio conversation support 

ua_seize(size : int, datal, data2 : string) : int 
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ml := retrieve ("m=", datal); atypel := snth<2, ml); anl := snth{3, ml); 
ro2 :«= retrieve ("m=", data2); atype2 := snth(2, m2); an2 := snth{3, m2); 
if { start ( "RTP/ " , atypel) && start ( "RTP/ " , atype2) && anl "0" an2 == "0") { 

# Seize the sound system disable all sound effects 
Sen <-=(•>", 0); 

# Only case Rch is used: synchronize with sound muted 
<- Rch; 

rtpmap := snthd, retrieve ( "a=rtpmap:0" , datal)); 

(nil, ptime) := expand2t (retrieve ( "a=ptime :" , datal), ":"); 

atype := audio type (rtpmap, ptime) ; 

ua->setAudioFormat (atype, 1, 8, 12); 

(ok, reason) : = audio2open ( ) ; 

if (ok < 0) sys->fprint(stderr, Mod+": %s\n", reason); 
else { 

if (Dbg) sys->print (Mod+" : UCBAudio open %s %s format buffer size %d\n" , rtpmap, ptime, ok); 
size = ok; 
if (debug) { 

checkua ( ) ; 

looptest (size, 1000); 

} 

} 

else sys->fprint (stderr, Mod+": cannot negotiate audio %s %s\n", atypel, atype2); 
return size; 

} 

ua_release ( ) 
{ 

(ok, reason) := ua->audioClose ( ) ; 

if (ok < 0) sys->f print (stderr, Mod+": %s\n", reason); 
else if (Dbg) sys->print (Mod+" : UCBAudio closed\n"); 
Sch <- = ("<", 0); 

} 

audiotype (rtpmap, ptime : string) : int 
{ 

case rtpmap { 

"PCMU/8000" => 

case ptime { 

"10" => return UCBAudio->G711MULAWFl0; 
"15" => return UCBAudio->G71lMULAWF15; 
"20" => return UCBAudio->G711MULAWF20; 
"25" => return UCBAudio->G711MULAWF25; 
"30" => return UCBAudio- >G711MULAWF30; 

} 

"PCM/8000" => 

case ptime { 

"10" => return UCBAudio- >PCM8000F10 ; 
"15" => return UCBAudio->PCM8000F15; 
"20" => return UCBAudio->PCM8000F20 ; 
"25" => return UCBAudio->PCM8000F25; 
"30" => return UCBAudio->PCM8000F30; 

# => sys->fprint (stderr, Mod+" : cannot set this audio %s %s\n", rtpmap, ptime); 

} 

return UCBAudio->G711MULAWF20; 

} 

checkua ( ) 
{ 

t not sure why info is needed in the ua api! 

# info := ua->AudioFormatInfo(0,0,0,0.0,0,0) ; 

info := ua->AudioFormatlnfo(UCBAudio->G711MULAWF20, 8000, 20, 160, 1, 12, 8); 
(ok, reason) := ua->getAudioParams (ref info); 

sys->print (Mod+" : UCBAudio audio params %d %s\n" , ok, reason); 

sys->print (Mod+" : Format lD\t%d\nSampleRate\t%d\nFrameSize\t%d\nFrameBuf Si ze\t%d\nProtocol\t%d\nFrameHeader\t%d\nJitterBuf f er\t%d\n" , 
(ok, reason) = ua->getSpeakerVol ( ) ; 

sys->print (Mod+" : UCBAudio speaker volume %d %s\n", ok, reason); 
(ok, reason) = ua->getMicGain( ) ; 

sys->print(Mod+" : UCBAudio mic gain %d %s\n", ok, reason); 

) 

looptest (size, max : int) 
( 

if (ua == nil) return; 
buf := array [size] of byte; 
ok : int; err : string; 
for(i := 0; i < max; i++) { 

(ok, err) = ua->recordFrame (buf ) ; 

if (ok < 0) break; 

(ok, err) = ua->playFrame (buf ) ; 

if (ok < 0) break; 

} 

if (ok < 0) sys->f print (stderr, Mod+": error: %s\n", err); 

) 

# Serialized sound effect processor 

# Sch is the only allowed interface channel 

# to the sound system above this layer 

Sch : chan of (string, int); 
Rch : chan of (string, int); 
Spid := 0; 

soundtch : chan of int) 
< 

Sch = chan of (string, int); 
Rch = chan of (string, int); 
ch <- = Spid = sys->pctl(0, nil); 
mute := 0; 
while (Spid) { 

(C, n) := <- Sch; 

case c { 

->" => { stopsound ( ) ; mute = 1; Rch <- = (c, n) ,- } 
"<" => mute = 0; 
* => if (!mute) { 

if (Dbg) sys->print(Mod+" : sound received (%s, %d)\n", c, n); 

startsound (c, n) ; 

) 

} 

} 

if (Dbg) sys->print (Mod+" : sound process ends\n">; 

> 

Soundir : con "/sounds/"; 
startsound (c : string, n : int) 
{ 

stopsound ( ) ; 
f := Soundir; 
case c { 
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=> return; 
"a" => f += "dialtoneseg.pom" ; 
"b" => f += "busy. pern" ; 
■c" or •£" => f += "click. pem"; 
"x" => f += "f astbusy.pcm" ,- 
"r" => f = Ringer ; 
"w" => f += "ringback.pcm" ; 

* => 

if (Soundp < 2) return; 

else if (len c == 1 && keydigitpUnt c[0])) 

f += "dtmf »+c+" -pem"; 
else f += c; 

} 

if (Dbg) sys->print(Mod+" : f=%s\n", f); 

S.f = f; 

play(f :: string n :: nil); 

) 

stopsound ( ) 
{ 

if (S nil) S = ref Statetnil, nil, 0. nil); 
f := S.f; 
S.f = nil; 

if (f != nil) stoplf "waitstop" :: nil); 

} 

killsoundO 
{ 

pid := Spid; 

spawn sendScM"", 0, ch :~ chan of int); 

killer := <- ch; 

Spid = 0; 

sys->sleep (100) ; 

kill (pid); 

kill (killer) ; 

} 

sendSch(s : string, n : int, ch : chan of int) 
{ 

if (ch != nil) ch <- = sys->pctl(0, nil); 
Sch <- = (s, n); 

) 

# Extra ephone and testing testing and debugging 

test(args : list of string) 
{ 

case hd args { 

"d" or "debug" => debug = int hd tl args; 
■p" or "play" or "s" or "stop" => { 
args = tl args; 
ns : = " 1 " ; 

if (tl args !* nil) ns = hd tl args; 
Sch <- = (hd args, int ns); 

) 

or "set" => set(tl args) ; 

* => usage2(); 

} 

) 

usage2 ( ) 

sys->print ("other options to / tmp/sc : \n\td or debug\n\tp or play or s or stop\n\t= audio or init or proxy or sound or times or timeout or i 

) 

Ua : UCBAudiO; 

set(l : list of string) 
{ 

if (len 1 < 2) return; 
case hd 1 { 

"audio" => Def ault_audio ■ tl 1; 
"aproto" => { 

Aproto = hd tl 1; 

if (Aproto == "nil") { 

Aproto - def ault_aproto; 
tcpclear ( ) 

) 

else if (Aproto == "RTP/TCP") tcpaudio ( ) ; 

) 

"proxy" => { 

Proxy = hd tl 1; 

if (Proxy == "nil") Proxy » nil; 

else if (Registrar == nil) Registrar = Proxy; 

} 

"regis" => { 

Registrar = hd tl 1; 

if (Registrar == "nil") Registrar = nil; 

) 

"sound" => Soundp = int hd tl 1; 
"rtpport" => { 

Rtpport = hd tl 1; 

if (Rtpport == "nil") Rtpport = default_rtpport; 

} 

"rrtport" => { 

Rrtport = hd tl 1; 

if (Rrtport == "nil") Rrtport = def ault_rrtport; 

} 

"times" => Times = int hd tl 1; 
"timeout" => Timeout = int hd tl 1; 
"ua" => { 

if (hd tl 1 == "nil") { 

if (Ua — nil) Ua - ua; ua = nil; 

) 

else if (Ua « nil) { 

Ua = ua; ua = Ua; 

} 

} 

* => return; 

if (hd 1 == "audio") sys->print (Mod+" : %s = %s", hd 1, ls(tl 1)); 
else sys->print(Mod+": %s = %s\n", hd 1, hd tl 1); 

} 

ls(l : list of string) : string 
{ 

r := "("; 
s := " "; 

for (; 1 != nil; 1 = tl 1) { 
r += hd 1; 

if (tl 1 i= nil) r += " "; 
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return r + ">"; 

> 

Default_audio : list of string; 
Times := 21; 

play (args : list of string) 
{ 

if (ua == nil) return; 
if (args == nil) return; 

f := hd args; 
times := Times ; 
args = tl args; 

if {args ! = nil) {times = int hd args; args = tl args;} 

if {f — Ringer) { 

ch := chan of int; 

spawn ringing (soundc ache (f, nil), times, ch) ; 

<- ch; 

return; 

(typ, proto, jitter, header) := audioinfoi); 
if (typ == 0) { 

(name, ext) := expand2t(f, "."); 

typ = audioformat (ext) ; 

} 

if (typ != 0) { 

ch := chan of int; 

spawn pi aysoundf soundc ache (f , typ :: proto :: jitter :: header :: nil), times, ch) ; 
<- ch; 

> 

else sys->fprint (stderr, Mod+"+ cannot play sample of type %d\n", typ); 

> 

stop (args : list of string) 
< 

if (ua — nil) return; 

if (args « nil) return; 

s := soundcachethd args, nil); 

if (s « nil) sys->f print (stderr, Mod+": sound not found %s\n", hd args); 
else if (s. state == 0) sys->fprint (stderr , Mod+": not playing %s\n", s.name); 
else { 

audi op := s.name != Ringer; 
if (tl args != nil) ( 

pid := s. state; 

s. state = 0; 

if (Soundp >= 0) 

timeoutkill (pid, 250, 10, audi op ) ; 

} 

else { 

if (Soundp >= 0) 

spawn timeoutkill (s. state, 1500, 200, audiop) ; 
s. state = 0; 

} 

} 

} 

timeoutkill (pid, timeout, quantum, audiop : int) 
{ 

pstat := "/prog/ "+string pid+" /status" ; 
nc := timeout/ quantum ,- 

while (sys->open (pstat, sys->OREAD) != nil) { 
sys->sleep (quantum) ; 
if (nc-- <= 0) { 

if (Dbg) sys->print (Mod+" : timeout killing %d\n", pid) ; 
kill (pid) ; 

if (audiop && ua »= nil) ua->audioClose { ) ; 
re turn ; 

} 

> 

if (Dbg) sys->print(Mod+" : process %d is done\n", pid) ,- 

} 

Sound : adt 
{ 

buf : array of byte; 
name : string; 
state : int; 
info : list of int; 

); 

Cache : list of ref Sound; 

soundcache(f : string, info : list of int) : ref Sound 
{ 

buf : array of string; 

ford := Cache; 1 != nil; 1 = tl 1) 

if ( (hd D.name == f) return (hd 1); 
# Artificial reference to Ringer 
if (f == Ringer) { 

Cache = (s := ref Sound(nil, Ringer, 0, info)) :: Cache; 

return s; 

) 

if (info == nil) return nil; 
(ok, dir) := sys->stat (f ) ; 
if (ok < 0) { 

sys->f print (stderr, Mod+": stat %s: %r\n", f); 

return nil; 

} 

else { 

fd := sys->open(£, Sys->OREAD) ; 

n := dir. length; 

buf := array tn] of byte; 

n = sys->read(fd, buf, n) ,- 

if (n < 0) { 

sys->fprint (stderr, Mod+": read %s: %r\n", £); 

return nil; 

} 

if (n != dir. length) buf = buf [0:n]; 

Cache = (s := ref Sound(buf, f, 0, info)) :: Cache; 

return s; 

} 

) 

audio2open() : (int, string) 
t 

(ok, reason) := ua->audioOpen{ ) ; 
if (ok < 0) { 
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sys->f print (stderr, Mod+": %s\n", reason); 
(ok, reason) = ua->audioClose ( ) ; 

if (ok < 0) sys->f print (stderr, Mod+": %s\n", reason); 
(ok, reason) = ua->audioOpen ( ) ; 

) 

return (ok, reason); 

) 

Soundp := 1; 

playsound(s : ref Sound, times : int, ch : chain of int) 
{ 

ch <- - sys->pctl(0, nil); 
if (s « nil) { 

sys->f print (stderr, Mod+": sound sample not found\n"); 

return; 

) 

buf := s.buf; 
n := len buf; 
info s.info; 

(typ, proto, jitter, header) := values4 (info) ; 

if (Dbg) sys->print (Mod+" : open %s - %d %d %d %d\n", s.name, typ, proto, jitter, header) ; 
if (Soundp < 0) return; 

ua->setAudioFormat (typ, proto, jitter, header); 
(ok, reason) := audi o2 open () ; 

if (ok < 0) sys->fprint (stderr, Mod+ " : %s\n" , reason); 
else { 

f S := Ok; 

if (Dbg) sys->print(Mod+- : playsound %s size %d nframes %d times %d - %d %d %d %d\n", s.name. fs, n/fs, times, typ, proto, fitter, 
s. state = sys->pctl(0, nil); 
while (Soundp > 0 && times--) ( 

for(i := 0; i < n - fs; i += fs) 

if (is. state) break; 

else { 

(ok, reason) = ua->p lay Frame (buf [i : i+f s] ) ; 
if (ok < 0) break; 

} 

sys->sleep(100) ; 

} 

if (ok < 0) sys->f print (stderr, Mod+": %s\n", reason); 

} 

(ok, reason) = ua->audioClose ( ) ; 

if (ok < 0) sys->fprint (stderr, Mod+": %s\n" , reason); 

) 

values4(l : list of int) : (int, int, int, int) 

{ if (len 1 » 4) return (hd 1, hd tl 1 , hd tl tl 1, hd tl tl tl 1) ; 

return (0, 0, 0, 0); 

> 

audioinfoO : (int, int, int, int) 
{ 

1 := Def ault_audio; 

if (len 1 == 3) return (0, int hd 1, int hd tl 1, int hd tl tl 1); 

if (len 1 > 3) return (audiof ormat (hd 1), int hd tl 1, int hd tl tl 1, int hd tl tl tl 1); 
return (0, 0, 0, 0); 

> 

audi of ormat (ext : string) : int 
{ 

case ext { 

"pern" => return UCBAudio->PCM8000F30; 
"pcra20" => return UCBAudio->PCM8000F20; 
-pcmlO- => return UCBAudio->PCM8000F10 ; 
"ulw" => return UCBAudio->G711MULAWF30 ; 
"ulw20" => return UCBAudio->G711MULAWF20; 
■ulwlO" => return UCBAudio->G711MULAWF10; 

} 

return UCBAudio->G711MULAWF20; 

} 

Ringer : con "ringer"; 

ringing(s : ref Sound, times : int, ch : chan of int) 
{ 

if (s == nil) return; 

ch <- = s.state = sys->pctl(0, nil); 

fd := sys->open( " /dev/touch2dsp" , sys->OWRITE) ; 

while (times-- && s.state) 

if (sys->write (fd, array of byte Ringer, len Ringer) <= 0) { 

sys->f print (stderr, Mod+": cannot ring this phone\n" ) ; 

return; 

) 

else 

for(i := 0; i < 20 && s.state ; i++) 
sys->sleep{200) ; 

) 

* Added to restart device remotely 

restartdevice(ctxt : ref Draw->Context ) 
{ 

shipcleanup(ctxt) ; 

fdrb := sys->open( "/dev/sysctl" , Sys->OWRITE) ; 
if(fdrb != nil) 

sys->f print (fdrb, "reboot" ); 

} 

home : con " /usr/ inf erno/conf ig/ " ; 
tops : con home+" top/scripts/ " ; 

ethcon : con " /net/ipifc/0/ " ; 
route : con "/net/ iproute" ; 

shipcleanuplctxt : ref Draw- >Con text) 
{ 

sys->print (Mod+" : unconfig ephone connection \n" ) ,- 

# really should check on /dev/etherO too risky can halt the phone 
(ok, nil) := sys->stat (ethcon) ; 
if (ok >= 0) { 

(ok, nil) = sys->stat (tops+"eunbind" ) ; 

if (ok >= 0) 

shelKctxt, tops+"eunbind" :: tops+"eunmount" tops+"ethenot" :: nil); 
(ok2, nil) :» sys->stat (tops+"ethenot" ) ; 
if (ok < 0 || 0k2 < 0) ( 

buf := array (10243 of byte; 

fd -.= sys->open(ethcon+" status", sys->OREAD) ; 
n := sys->read(fd. buf, len buf); 
if (n >» 0) { 
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(m, 1) := sys->tokenize (string buf [0:n] . " \t\n\r"); 
if (m > 4) ( 

ethO := hd 1; 

if (ethO "/dev/etherO") sys->f print (stderr, Mod+": %s unexpected ether device %s\n", ethcon, hd 1); 
addr := hd tl tl 1; 
mask hd tl tl tl 1; 

if (masktO] « '/') mask = "255. 255. 255. 0"; 
gway := hd tl tl tl tl 1; 

if (Dbg) sys->print (Mod+" : found ether=%s addr=%s mask=%s gway=%s to unconf ig\n" , ethO, addr, mask, gway); 
fd = sys->open(ethcon+"ctl", Sys->OWRITE) ; 
if (fd == nil) ( 

sys->f print (stderr, Mod+": %s %r\n", ethcon+"ctl " > ; 

return; 

) 

sys->f print ( fd, "remove %s 255.255.255.0 %s", addr, gway); 
sys->seek(fd, 0, Sys->SEEKSTART) ; 
sys->fprint ( fd, "unbind ether %s", ethO); 
fd = sys->open (route, Sys->OWRiTE) ; 
if (fd == nil) { 

sys->f print (stderr, Mod+": %s %r\n", route); 

return; 

} 

sys->fprint(fd, "remove 0.0.0.0 0.0.0.0 %s", gway); 
sys->unmount ("#1", "/dev"); 

if (Dbg) sys->print (Mod+" : ethernet device unmount ed\n" ) ; 

) 

else sys->print(Mod+" : ethenet device not active\n"); 

> 

else sys->fprint (stderr, Mod+": %s %r\n", ethcon* "status" ) ; 

} 

) 

} 

shell (ctxt : ref Draw- >Con text , args : list of string) 
{ 

sh := load Command Command -> PATH; 
if (sh !■» nil) 

sh->init (ctxt, Command -> PATH :: "-n" :: args); 

else 

sys->f print ( stderr, Mod+": %s %r\n", Command -> PATH) ; 

> 
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